summaryrefslogtreecommitdiff
path: root/packages/ptc/src/win32/base
diff options
context:
space:
mode:
Diffstat (limited to 'packages/ptc/src/win32/base')
-rw-r--r--packages/ptc/src/win32/base/cursor.inc33
-rw-r--r--packages/ptc/src/win32/base/event.inc60
-rw-r--r--packages/ptc/src/win32/base/eventd.inc38
-rw-r--r--packages/ptc/src/win32/base/hook.inc253
-rw-r--r--packages/ptc/src/win32/base/hookd.inc40
-rw-r--r--packages/ptc/src/win32/base/kbd.inc283
-rw-r--r--packages/ptc/src/win32/base/kbdd.inc63
-rw-r--r--packages/ptc/src/win32/base/monitor.inc54
-rw-r--r--packages/ptc/src/win32/base/monitord.inc30
-rw-r--r--packages/ptc/src/win32/base/moused.inc55
-rw-r--r--packages/ptc/src/win32/base/mousei.inc176
-rw-r--r--packages/ptc/src/win32/base/ptcres.rc2
-rw-r--r--packages/ptc/src/win32/base/ptcres.resbin0 -> 1576 bytes
-rw-r--r--packages/ptc/src/win32/base/window.inc335
-rw-r--r--packages/ptc/src/win32/base/windowd.inc58
-rw-r--r--packages/ptc/src/win32/base/windows.icobin0 -> 1398 bytes
16 files changed, 1480 insertions, 0 deletions
diff --git a/packages/ptc/src/win32/base/cursor.inc b/packages/ptc/src/win32/base/cursor.inc
new file mode 100644
index 0000000000..2c5e6438c4
--- /dev/null
+++ b/packages/ptc/src/win32/base/cursor.inc
@@ -0,0 +1,33 @@
+{
+ Free Pascal port of the OpenPTC C++ library.
+ Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
+ Original C++ version by Glenn Fiedler (ptc@gaffer.org)
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+}
+
+Procedure Win32Cursor_resurrect;
+
+Begin
+ LOG('showing cursor');
+ While ShowCursor(True) < 0 Do;
+End;
+
+Procedure Win32Cursor_kill;
+
+Begin
+ LOG('hiding cursor');
+ While ShowCursor(False) >= 0 Do;
+End;
diff --git a/packages/ptc/src/win32/base/event.inc b/packages/ptc/src/win32/base/event.inc
new file mode 100644
index 0000000000..5c284dd97c
--- /dev/null
+++ b/packages/ptc/src/win32/base/event.inc
@@ -0,0 +1,60 @@
+{
+ Free Pascal port of the OpenPTC C++ library.
+ Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
+ Original C++ version by Glenn Fiedler (ptc@gaffer.org)
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+}
+
+Constructor TWin32Event.Create;
+
+Begin
+ { create event handle }
+ m_event := CreateEvent(Nil, True, False, Nil);
+
+ { check event handle }
+ If m_event = 0 Then
+ Raise TPTCError.Create('could not create event');
+End;
+
+Destructor TWin32Event.Destroy;
+
+Begin
+ { close handle }
+ CloseHandle(m_event);
+
+ Inherited Destroy;
+End;
+
+Procedure TWin32Event._set;
+
+Begin
+ { set event }
+ SetEvent(m_event);
+End;
+
+Procedure TWin32Event.reset;
+
+Begin
+ { reset event }
+ ResetEvent(m_event);
+End;
+
+Procedure TWin32Event.wait;
+
+Begin
+ { wait for event }
+ WaitForSingleObject(m_event, INFINITE);
+End;
diff --git a/packages/ptc/src/win32/base/eventd.inc b/packages/ptc/src/win32/base/eventd.inc
new file mode 100644
index 0000000000..d7948eeebc
--- /dev/null
+++ b/packages/ptc/src/win32/base/eventd.inc
@@ -0,0 +1,38 @@
+{
+ Free Pascal port of the OpenPTC C++ library.
+ Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
+ Original C++ version by Glenn Fiedler (ptc@gaffer.org)
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+}
+
+Type
+ TWin32Event = Class(TObject)
+ Private
+ { event handle }
+ m_event : HANDLE;
+ Public
+ { setup }
+ Constructor Create;
+ Destructor Destroy; Override;
+
+ { control }
+ Procedure _set;
+ Procedure reset;
+ Procedure wait;
+
+ { data access }
+ Property handle : HANDLE read m_event;
+ End;
diff --git a/packages/ptc/src/win32/base/hook.inc b/packages/ptc/src/win32/base/hook.inc
new file mode 100644
index 0000000000..87f72b7432
--- /dev/null
+++ b/packages/ptc/src/win32/base/hook.inc
@@ -0,0 +1,253 @@
+{
+ Free Pascal port of the OpenPTC C++ library.
+ Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
+ Original C++ version by Glenn Fiedler (ptc@gaffer.org)
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+}
+
+Type
+ PWin32Hook_Lookup = ^TWin32Hook_Lookup;
+ TWin32Hook_Lookup = Record
+ window : HWND;
+ wndproc : DWord;
+ hook : Array[0..15] Of TWin32Hook;
+ count : Integer;
+ End;
+
+Const
+ TWin32Hook_m_count : Integer = 0;
+ TWin32Hook_m_cached : PWin32Hook_Lookup = Nil;
+ TWin32Hook_m_monitor : TWin32Monitor = Nil;
+
+Var
+{ TWin32Hook_m_hook : HHOOK;}
+ TWin32Hook_m_registry : Array[0..15] Of TWin32Hook_Lookup;
+
+Function TWin32Hook_hook(hwnd : HWND; msg : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; StdCall;
+
+Var
+ lookup : PWin32Hook_Lookup;
+ i : Integer;
+
+Begin
+ { enter monitor }
+ TWin32Hook_m_monitor.enter;
+
+ { lookup pointer }
+ lookup := Nil;
+
+ { check cached lookup if valid }
+ If (TWin32Hook_m_cached <> Nil) And (TWin32Hook_m_cached^.window = hwnd) Then
+ { cached lookup match }
+ lookup := TWin32Hook_m_cached
+ Else
+ Begin
+ { search for matching window }
+ For i := 0 To TWin32Hook_m_count - 1 Do
+ { check for lookup window match }
+ If TWin32Hook_m_registry[i].window = hwnd Then
+ Begin
+ { setup cached lookup }
+ TWin32Hook_m_cached := @TWin32Hook_m_registry[i];
+
+ { setup lookup }
+ lookup := TWin32Hook_m_cached;
+
+ { break }
+ Break;
+ End;
+{$IFDEF DEBUG}
+ { check for search failure }
+ If lookup = Nil Then
+ Raise TPTCError.Create('TWin32Hook window lookup search failure!');
+{$ENDIF}
+ End;
+
+ { result value }
+ TWin32Hook_hook := 0;
+
+ { iterate all hooks for this window }
+ For i := lookup^.count - 1 DownTo 0 Do
+ Begin
+ { call hook window procedure }
+ TWin32Hook_hook := lookup^.hook[i].WndProc(hwnd, msg, wParam, lParam);
+
+ { check result value ? }
+ {If result = True Then Break;}
+ End;
+
+ { check result }
+ {If result <> True Then}
+
+ { call original window procedure }
+ result := CallWindowProc(WNDPROC(lookup^.wndproc), hwnd, msg, wParam, lParam);
+
+ { leave monitor }
+ TWin32Hook_m_monitor.leave;
+End;
+
+Constructor TWin32Hook.Create(window : HWND; thread : DWord);
+
+Begin
+ { setup data }
+ m_window := window;
+ m_thread := thread;
+
+ { add to registry }
+ add(m_window, m_thread);
+End;
+
+Destructor TWin32Hook.Destroy;
+
+Begin
+ { remove from registry }
+ remove(m_window, m_thread);
+ Inherited Destroy;
+End;
+
+Procedure TWin32Hook.Add(window : HWND; thread : DWord);
+
+Var
+ index, insert : Integer;
+
+Begin
+ { enter monitor }
+ TWin32Hook_m_monitor.enter;
+
+ { invalidate cache }
+ TWin32Hook_m_cached := Nil;
+
+ { registry index }
+ index := 0;
+
+ { iterate registry }
+ While index < TWin32Hook_m_count Do
+ Begin
+ { search for existing window hook }
+ If TWin32Hook_m_registry[index].window = window Then
+ { match }
+ Break;
+
+ { next }
+ Inc(index);
+ End;
+
+ { check results }
+ If index <> TWin32Hook_m_count Then
+ Begin
+ { get insertion point for hook }
+ insert := TWin32Hook_m_registry[index].count;
+
+ { increase hook count }
+ Inc(TWin32Hook_m_registry[index].count);
+
+{$IFDEF DEBUG}
+ { Check for maximum hook count }
+ If TWin32Hook_m_registry[index].count > (High(TWin32Hook_m_registry[index].hook) + 1) Then
+ Raise TPTCError.Create('TWin32Hook too many hooks created!');
+{$ENDIF}
+
+ { insert hook in registry }
+ TWin32Hook_m_registry[index].hook[insert] := Self;
+ End
+ Else
+ Begin
+ { setup new lookup }
+ TWin32Hook_m_registry[index].wndproc := GetWindowLong(window, GWL_WNDPROC);
+ TWin32Hook_m_registry[index].window := window;
+ TWin32Hook_m_registry[index].hook[0] := Self;
+ TWin32Hook_m_registry[index].count := 1;
+
+ { increase lookup count }
+ Inc(TWin32Hook_m_count);
+
+{$IFDEF DEBUG}
+ { check for maximum count }
+ If TWin32Hook_m_count > (High(TWin32Hook_m_registry) + 1) Then
+ Raise TPTCError.Create('TWin32Hook too many lookups created!');
+{$ENDIF}
+
+ { set window procedure to hook procedure }
+ SetWindowLong(window, GWL_WNDPROC, DWord(@TWin32Hook_hook));
+ End;
+
+ { leave monitor }
+ TWin32Hook_m_monitor.leave;
+End;
+
+Procedure TWin32Hook.Remove(window : HWND; thread : DWord);
+
+Var
+ index, i, j : Integer;
+
+Begin
+ { enter monitor }
+ TWin32Hook_m_monitor.enter;
+
+ { invalidate cache }
+ TWin32Hook_m_cached := Nil;
+
+ { registry index }
+ index := 0;
+
+ { iterate registry }
+ While index < TWin32Hook_m_count Do
+ Begin
+ { check for window match }
+ If TWin32Hook_m_registry[index].window = window Then
+ Begin
+ { search for Self }
+ For i := 0 To TWin32Hook_m_registry[index].count Do
+ { check hook }
+ If TWin32Hook_m_registry[index].hook[i] = Self Then
+ Begin
+ { remove this hook (quite inefficient for high count...) }
+ For j := i To TWin32Hook_m_registry[index].count - 2 Do
+ TWin32Hook_m_registry[index].hook[j] :=
+ TWin32Hook_m_registry[index].hook[j + 1];
+
+ { decrease hook count }
+ Dec(TWin32Hook_m_registry[index].count);
+
+ { break }
+ Break;
+ End;
+
+ { check remaining hook count }
+ If TWin32Hook_m_registry[index].count = 0 Then
+ Begin
+ { restore original window procedure }
+ SetWindowLong(window, GWL_WNDPROC, TWin32Hook_m_registry[i].wndproc);
+
+ { remove this lookup (quite inefficient for high count...) }
+ For i := index To TWin32Hook_m_count - 2 Do
+ TWin32Hook_m_registry[i] := TWin32Hook_m_registry[i + 1];
+
+ { decrease count }
+ Dec(TWin32Hook_m_count);
+ End;
+
+ { break }
+ Break;
+ End;
+
+ { next }
+ Inc(index);
+ End;
+
+ { leave monitor }
+ TWin32Hook_m_monitor.leave;
+End;
diff --git a/packages/ptc/src/win32/base/hookd.inc b/packages/ptc/src/win32/base/hookd.inc
new file mode 100644
index 0000000000..286680b993
--- /dev/null
+++ b/packages/ptc/src/win32/base/hookd.inc
@@ -0,0 +1,40 @@
+{
+ Free Pascal port of the OpenPTC C++ library.
+ Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
+ Original C++ version by Glenn Fiedler (ptc@gaffer.org)
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+}
+
+Type
+ TWin32Hook = Class(TObject)
+ Private
+ Procedure Add(window : HWND; thread : DWord);
+ Procedure Remove(window : HWND; thread : DWord);
+
+ m_window : HWND;
+ m_thread : DWord;
+
+ {m_hook : HHOOK;
+ m_count : Integer;
+ m_cached : PWin32Hook_Lookup;
+ m_registry : Array[0..15] Of TWin32Hook_Lookup;
+ m_monitor : TWin32Monitor;}
+ Protected
+ Function WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; Virtual; Abstract;
+ Public
+ Constructor Create(window : HWND; thread : DWord);
+ Destructor Destroy; Override;
+ End;
diff --git a/packages/ptc/src/win32/base/kbd.inc b/packages/ptc/src/win32/base/kbd.inc
new file mode 100644
index 0000000000..fa2c7a209d
--- /dev/null
+++ b/packages/ptc/src/win32/base/kbd.inc
@@ -0,0 +1,283 @@
+{
+ Free Pascal port of the OpenPTC C++ library.
+ Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
+ Original C++ version by Glenn Fiedler (ptc@gaffer.org)
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+}
+
+Constructor TWin32Keyboard.Create(window : HWND; thread : DWord; multithreaded : Boolean; EventQueue : TEventQueue);
+
+Begin
+ m_monitor := Nil;
+ m_event := Nil;
+ Inherited Create(window, thread);
+ m_monitor := TWin32Monitor.Create;
+ m_event := TWin32Event.Create;
+
+ { setup defaults }
+ m_alt := False;
+ m_shift := False;
+ m_control := False;
+
+ { setup data }
+ FEventQueue := EventQueue;
+ m_multithreaded := multithreaded;
+
+ { enable buffering }
+ m_enabled := True;
+End;
+
+Destructor TWin32Keyboard.Destroy;
+
+Begin
+ m_event.Free;
+ m_monitor.Free;
+ Inherited Destroy;
+End;
+
+(*Function TWin32Keyboard.internal_PeekKey(window : TWin32Window; k : TPTCKeyEvent) : Boolean;
+
+Begin
+ { check enabled flag }
+ If Not m_enabled Then
+ Begin
+ Result := False;
+ Exit;
+ End;
+
+ { enter monitor if multithreaded }
+ If m_multithreaded Then
+ m_monitor.enter;
+
+ { update window }
+ window.update;
+
+ { is a key ready? }
+ Result := ready;
+
+ If Result = True Then
+ k.Assign(m_buffer[m_tail]);
+
+ { leave monitor if multithreaded }
+ If m_multithreaded Then
+ m_monitor.leave;
+End;
+
+Procedure TWin32Keyboard.internal_ReadKey(window : TWin32Window; k : TPTCKeyEvent);
+
+Var
+ read : TPTCKeyEvent;
+
+Begin
+ read := Nil;
+
+ Try
+ { check enabled flag }
+ If Not m_enabled Then
+ Begin
+ read := TPTCKeyEvent.Create;
+ Exit;
+ End;
+
+ { check if multithreaded }
+ If m_multithreaded Then
+ Begin
+ { check if ready }
+ If Not ready Then
+ Begin
+ { wait for key event }
+ m_event.wait;
+
+ { reset event }
+ m_event.reset;
+ End;
+
+ { enter monitor }
+ m_monitor.enter;
+
+ { remove key }
+ read := remove;
+
+ { leave monitor }
+ m_monitor.leave;
+ End
+ Else
+ Begin
+ { update until ready }
+ While Not ready Do
+ { update window }
+ window.update;
+
+ { remove key }
+ read := remove;
+ End;
+ Finally
+ If Assigned(read) Then
+ k.Assign(read);
+ read.Free;
+ End;
+End;*)
+
+Procedure TWin32Keyboard.enable;
+
+Begin
+ { enable buffering }
+ m_enabled := True;
+End;
+
+Procedure TWin32Keyboard.disable;
+
+Begin
+ { disable buffering }
+ m_enabled := False;
+End;
+
+Function TWin32Keyboard.WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT;
+
+Var
+ i : Integer;
+ scancode : Integer;
+ KeyStateArray : Array[0..255] Of Byte;
+ AsciiBuf : Word;
+ press : Boolean;
+ uni : Integer;
+ tmp : Integer;
+
+Begin
+ WndProc := 0;
+ { check enabled flag }
+ If Not m_enabled Then
+ Exit;
+
+ { process key message }
+ If (message = WM_KEYDOWN) Or (message = WM_KEYUP) {Or ((message = WM_SYSKEYDOWN) And ((lParam And (1 Shl 29)) <> 0))} Then
+ Begin
+ If message = WM_KEYUP Then
+ press := False
+ Else
+ press := True;
+
+ { update modifiers }
+ If wParam = VK_MENU Then
+ { alt }
+ m_alt := press
+ Else
+ If wParam = VK_SHIFT Then
+ { shift }
+ m_shift := press
+ Else
+ If wParam = VK_CONTROL Then
+ { control }
+ m_control := press;
+
+ { enter monitor if multithreaded }
+ If m_multithreaded Then
+ m_monitor.enter;
+
+ uni := -1;
+
+ If GetKeyboardState(@KeyStateArray) Then
+ Begin
+ scancode := (lParam Shr 16) And $FF;
+ {todo: ToUnicode (Windows NT)}
+ tmp := ToAscii(wParam, scancode, @KeyStateArray, @AsciiBuf, 0);
+ If (tmp = 1) Or (tmp = 2) Then
+ Begin
+ If tmp = 2 Then
+ Begin
+// Writeln('[', AsciiBuf, ']'); {???? todo: dead keys ????}
+ End
+ Else
+ Begin
+// Write(Chr(AsciiBuf));
+ {todo: codepage -> unicode}
+ If AsciiBuf <= 126 Then
+ uni := AsciiBuf;
+ End;
+
+ End;
+ End;
+
+ { handle key repeat count }
+ For i := 1 To lParam And $FFFF Do
+ { create and insert key object }
+ FEventQueue.AddEvent(TPTCKeyEvent.Create(wParam, uni, m_alt, m_shift, m_control, press));
+
+ { check multithreaded flag }
+ If m_multithreaded Then
+ Begin
+ { set event }
+ m_event._set;
+
+ { leave monitor }
+ m_monitor.leave;
+ End;
+ End;
+(* Else
+ If message = WM_KEYUP Then
+ { update modifiers }
+ If wParam = VK_MENU Then
+ { alt up }
+ m_alt := False
+ Else
+ If wParam = VK_SHIFT Then
+ { shift up }
+ m_shift := False
+ Else
+ If wParam = VK_CONTROL Then
+ { control up }
+ m_control := False;*)
+End;
+
+(*Procedure TWin32Keyboard.insert(_key : TPTCKeyEvent);
+
+Begin
+ { check for overflow }
+ If (m_head <> (m_tail - 1)) And
+ ((m_tail <> 0) Or (m_head <> High(m_buffer))) Then
+ Begin
+ { insert key at head }
+ m_buffer[m_head] := _key;
+
+ { increase head }
+ Inc(m_head);
+
+ { wrap head from end to start }
+ If m_head > High(m_buffer) Then
+ m_head := Low(m_buffer);
+ End;
+End;
+
+Function TWin32Keyboard.remove : TPTCKeyEvent;
+
+Begin
+ { return key data from tail }
+ remove := m_buffer[m_tail];
+
+ { increase tail }
+ Inc(m_tail);
+
+ { wrap tail from end to start }
+ If m_tail > High(m_buffer) Then
+ m_tail := Low(m_buffer);
+End;
+
+Function TWin32Keyboard.ready : Boolean;
+
+Begin
+ ready := m_head <> m_tail;
+End;
+*)
diff --git a/packages/ptc/src/win32/base/kbdd.inc b/packages/ptc/src/win32/base/kbdd.inc
new file mode 100644
index 0000000000..8cd947008b
--- /dev/null
+++ b/packages/ptc/src/win32/base/kbdd.inc
@@ -0,0 +1,63 @@
+{
+ Free Pascal port of the OpenPTC C++ library.
+ Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
+ Original C++ version by Glenn Fiedler (ptc@gaffer.org)
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+}
+
+Type
+ TWin32Keyboard = Class(TWin32Hook)
+ Private
+ { window procedure }
+ Function WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; Override;
+
+ { internal key functions }
+{ Procedure insert(_key : TPTCKeyEvent);
+ Function remove : TPTCKeyEvent;
+ Function ready : Boolean;}
+
+ { data }
+{ m_key : Boolean;}
+ m_multithreaded : Boolean;
+ m_event : TWin32Event;
+ m_monitor : TWin32Monitor;
+ FEventQueue : TEventQueue;
+
+ { flag data }
+ m_enabled : Boolean;
+
+ { modifiers }
+ m_alt : Boolean;
+ m_shift : Boolean;
+ m_control : Boolean;
+
+ { key buffer }
+{ m_head : Integer;
+ m_tail : Integer;
+ m_buffer : Array[0..1023] Of TPTCKeyEvent;}
+ Public
+ { setup }
+ Constructor Create(window : HWND; thread : DWord; multithreaded : Boolean; EventQueue : TEventQueue);
+ Destructor Destroy; Override;
+
+ { input }
+{ Function internal_PeekKey(window : TWin32Window; k : TPTCKeyEvent) : Boolean;
+ Procedure internal_ReadKey(window : TWin32Window; k : TPTCKeyEvent);}
+
+ { control }
+ Procedure enable;
+ Procedure disable;
+ End;
diff --git a/packages/ptc/src/win32/base/monitor.inc b/packages/ptc/src/win32/base/monitor.inc
new file mode 100644
index 0000000000..7e40c13972
--- /dev/null
+++ b/packages/ptc/src/win32/base/monitor.inc
@@ -0,0 +1,54 @@
+{
+ Free Pascal port of the OpenPTC C++ library.
+ Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
+ Original C++ version by Glenn Fiedler (ptc@gaffer.org)
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+}
+
+{ $DEFINE __DISABLE_MULTITHREADING__}
+
+Constructor TWin32Monitor.Create;
+
+Begin
+{$IFNDEF __DISABLE_MULTITHREADING__}
+ InitializeCriticalSection(m_handle);
+{$ENDIF}
+End;
+
+Destructor TWin32Monitor.Destroy;
+
+Begin
+{$IFNDEF __DISABLE_MULTITHREADING__}
+ DeleteCriticalSection(m_handle);
+{$ENDIF}
+ Inherited Destroy;
+End;
+
+Procedure TWin32Monitor.enter;
+
+Begin
+{$IFNDEF __DISABLE_MULTITHREADING__}
+ EnterCriticalSection(m_handle);
+{$ENDIF}
+End;
+
+Procedure TWin32Monitor.leave;
+
+Begin
+{$IFNDEF __DISABLE_MULTITHREADING__}
+ LeaveCriticalSection(m_handle);
+{$ENDIF}
+End;
diff --git a/packages/ptc/src/win32/base/monitord.inc b/packages/ptc/src/win32/base/monitord.inc
new file mode 100644
index 0000000000..ea4cd806ec
--- /dev/null
+++ b/packages/ptc/src/win32/base/monitord.inc
@@ -0,0 +1,30 @@
+{
+ Free Pascal port of the OpenPTC C++ library.
+ Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
+ Original C++ version by Glenn Fiedler (ptc@gaffer.org)
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+}
+
+Type
+ TWin32Monitor = Class(TObject)
+ Private
+ m_handle : CRITICAL_SECTION;
+ Public
+ Constructor Create;
+ Destructor Destroy; Override;
+ Procedure enter;
+ Procedure leave;
+ End;
diff --git a/packages/ptc/src/win32/base/moused.inc b/packages/ptc/src/win32/base/moused.inc
new file mode 100644
index 0000000000..dfaa911c86
--- /dev/null
+++ b/packages/ptc/src/win32/base/moused.inc
@@ -0,0 +1,55 @@
+{
+ Free Pascal port of the OpenPTC C++ library.
+ Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
+ Original C++ version by Glenn Fiedler (ptc@gaffer.org)
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+}
+
+Type
+ TWin32Mouse = Class(TWin32Hook)
+ Private
+ { window procedure }
+ Function WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT; Override;
+
+ FEventQueue : TEventQueue;
+
+ FFullScreen : Boolean;
+
+ { the actual image area, inside the window (top left and bottom right corner) }
+ FWindowX1, FWindowY1, FWindowX2, FWindowY2 : Integer;
+
+ { console resolution
+ - mouse cursor position as seen by the user must always be in range:
+ [0..FConsoleWidth-1, 0..FConsoleHeight-1] }
+ FConsoleWidth, FConsoleHeight : Integer;
+
+ FPreviousMouseButtonState : TPTCMouseButtonState;
+ FPreviousMouseX, FPreviousMouseY : Integer; { for calculating the deltas }
+ FPreviousMousePositionSaved : Boolean; { true, if FPreviousMouseX,
+ FPreviousMouseY and FPreviousMouseButtonState contain valid values }
+
+ { flag data }
+ FEnabled : Boolean;
+ Public
+ { setup }
+ Constructor Create(window : HWND; thread : DWord; multithreaded : Boolean; EventQueue : TEventQueue; FullScreen : Boolean; ConsoleWidth, ConsoleHeight : Integer);
+
+ Procedure SetWindowArea(WindowX1, WindowY1, WindowX2, WindowY2 : Integer);
+
+ { control }
+ Procedure enable;
+ Procedure disable;
+ End;
diff --git a/packages/ptc/src/win32/base/mousei.inc b/packages/ptc/src/win32/base/mousei.inc
new file mode 100644
index 0000000000..87500f6a39
--- /dev/null
+++ b/packages/ptc/src/win32/base/mousei.inc
@@ -0,0 +1,176 @@
+{
+ Free Pascal port of the OpenPTC C++ library.
+ Copyright (C) 2001-2006 Nikolay Nikolov (nickysn@users.sourceforge.net)
+ Original C++ version by Glenn Fiedler (ptc@gaffer.org)
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+}
+
+Constructor TWin32Mouse.Create(window : HWND; thread : DWord; multithreaded : Boolean; EventQueue : TEventQueue; FullScreen : Boolean; ConsoleWidth, ConsoleHeight : Integer);
+
+Begin
+ Inherited Create(window, thread);
+
+ FEventQueue := EventQueue;
+
+ FFullScreen := FullScreen;
+ FConsoleWidth := ConsoleWidth;
+ FConsoleHeight := ConsoleHeight;
+
+ FPreviousMousePositionSaved := False;
+
+ { enable buffering }
+ FEnabled := True;
+End;
+
+Procedure TWin32Mouse.SetWindowArea(WindowX1, WindowY1, WindowX2, WindowY2 : Integer);
+
+Begin
+ FWindowX1 := WindowX1;
+ FWindowY1 := WindowY1;
+ FWindowX2 := WindowX2;
+ FWindowY2 := WindowY2;
+End;
+
+Procedure TWin32Mouse.enable;
+
+Begin
+ { enable buffering }
+ FEnabled := True;
+End;
+
+Procedure TWin32Mouse.disable;
+
+Begin
+ { disable buffering }
+ FEnabled := False;
+End;
+
+Function TWin32Mouse.WndProc(hWnd : HWND; message : DWord; wParam : WPARAM; lParam : LPARAM) : LRESULT;
+
+Var
+ fwKeys : Integer;
+ xPos, yPos : Integer;
+ LButton, MButton, RButton : Boolean;
+ TranslatedXPos, TranslatedYPos : Integer;
+ PTCMouseButtonState : TPTCMouseButtonState;
+ WindowRect : RECT;
+
+ button : TPTCMouseButton;
+ before, after : Boolean;
+ cstate : TPTCMouseButtonState;
+
+Begin
+ Result := 0;
+ { check enabled flag }
+ If Not FEnabled Then
+ Exit;
+
+ If (message = WM_MOUSEMOVE) Or
+ (message = WM_LBUTTONDOWN) Or (message = WM_LBUTTONUP) Or (message = WM_LBUTTONDBLCLK) Or
+ (message = WM_MBUTTONDOWN) Or (message = WM_MBUTTONUP) Or (message = WM_MBUTTONDBLCLK) Or
+ (message = WM_RBUTTONDOWN) Or (message = WM_RBUTTONUP) Or (message = WM_RBUTTONDBLCLK) Then
+ Begin
+ fwKeys := wParam; {MK_LBUTTON or MK_MBUTTON or MK_RBUTTON or MK_CONTROL or MK_SHIFT}
+ xPos := lParam And $FFFF;
+ yPos := (lParam Shr 16) And $FFFF;
+
+ LButton := (fwKeys And MK_LBUTTON) <> 0;
+ MButton := (fwKeys And MK_MBUTTON) <> 0;
+ RButton := (fwKeys And MK_RBUTTON) <> 0;
+
+ If Not FFullScreen Then
+ Begin
+ GetClientRect(hWnd, WindowRect);
+
+ FWindowX1 := WindowRect.left;
+ FWindowY1 := WindowRect.top;
+ FWindowX2 := WindowRect.right - 1;
+ FWindowY2 := WindowRect.bottom - 1;
+ End;
+
+ If (xPos >= FWindowX1) And (yPos >= FWindowY1) And
+ (xPos <= FWindowX2) And (yPos <= FWindowY2) Then
+ Begin
+ If FWindowX2 <> FWindowX1 Then
+ TranslatedXPos := (xPos - FWindowX1) * (FConsoleWidth - 1) Div (FWindowX2 - FWindowX1)
+ Else { avoid div by zero }
+ TranslatedXPos := 0;
+
+ If FWindowY2 <> FWindowY1 Then
+ TranslatedYPos := (yPos - FWindowY1) * (FConsoleHeight - 1) Div (FWindowY2 - FWindowY1)
+ Else { avoid div by zero }
+ TranslatedYPos := 0;
+
+ { Just in case... }
+ If TranslatedXPos < 0 Then
+ TranslatedXPos := 0;
+ If TranslatedYPos < 0 Then
+ TranslatedYPos := 0;
+ If TranslatedXPos >= FConsoleWidth Then
+ TranslatedXPos := FConsoleWidth - 1;
+ If TranslatedYPos >= FConsoleHeight Then
+ TranslatedYPos := FConsoleHeight - 1;
+
+ If Not LButton Then
+ PTCMouseButtonState := []
+ Else
+ PTCMouseButtonState := [PTCMouseButton1];
+
+ If RButton Then
+ PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton2];
+
+ If MButton Then
+ PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton3];
+
+ If Not FPreviousMousePositionSaved Then
+ Begin
+ FPreviousMouseX := TranslatedXPos; { first DeltaX will be 0 }
+ FPreviousMouseY := TranslatedYPos; { first DeltaY will be 0 }
+ FPreviousMouseButtonState := [];
+ End;
+
+ { movement? }
+ If (TranslatedXPos <> FPreviousMouseX) Or (TranslatedYPos <> FPreviousMouseY) Then
+ FEventQueue.AddEvent(TPTCMouseEvent.Create(TranslatedXPos, TranslatedYPos, TranslatedXPos - FPreviousMouseX, TranslatedYPos - FPreviousMouseY, FPreviousMouseButtonState));
+
+ { button presses/releases? }
+ cstate := FPreviousMouseButtonState;
+ For button := Low(button) To High(button) Do
+ Begin
+ before := button In FPreviousMouseButtonState;
+ after := button In PTCMouseButtonState;
+ If after And (Not before) Then
+ Begin
+ { button was pressed }
+ cstate := cstate + [button];
+ FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate, True, button));
+ End
+ Else
+ If before And (Not after) Then
+ Begin
+ { button was released }
+ cstate := cstate - [button];
+ FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate, False, button));
+ End;
+ End;
+
+ FPreviousMouseX := TranslatedXPos;
+ FPreviousMouseY := TranslatedYPos;
+ FPreviousMouseButtonState := PTCMouseButtonState;
+ FPreviousMousePositionSaved := True;
+ End;
+ End;
+End;
diff --git a/packages/ptc/src/win32/base/ptcres.rc b/packages/ptc/src/win32/base/ptcres.rc
new file mode 100644
index 0000000000..2ce506383b
--- /dev/null
+++ b/packages/ptc/src/win32/base/ptcres.rc
@@ -0,0 +1,2 @@
+IDI_PTC_ICON ICON "windows.ico"
+#AppIcon ICON "windows.ico"
diff --git a/packages/ptc/src/win32/base/ptcres.res b/packages/ptc/src/win32/base/ptcres.res
new file mode 100644
index 0000000000..c320585c44
--- /dev/null
+++ b/packages/ptc/src/win32/base/ptcres.res
Binary files differ
diff --git a/packages/ptc/src/win32/base/window.inc b/packages/ptc/src/win32/base/window.inc
new file mode 100644
index 0000000000..799a61cf84
--- /dev/null
+++ b/packages/ptc/src/win32/base/window.inc
@@ -0,0 +1,335 @@
+{
+ Free Pascal port of the OpenPTC C++ library.
+ Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
+ Original C++ version by Glenn Fiedler (ptc@gaffer.org)
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+}
+
+{ $R win32\base\ptcres.res}
+
+{ bug in the compiler???}
+{ $LINKLIB ptc.owr}
+
+Constructor TWin32Window.Create(window : HWND);
+
+Begin
+ LOG('attaching to user managed window');
+ defaults;
+ m_window := window;
+ m_managed := False;
+End;
+
+Constructor TWin32Window.Create(wndclass, title : String; extra, style : DWord; show, x, y, width, height : Integer; center, _multithreaded : Boolean; data : Pointer);
+
+Begin
+ internal_create(wndclass, title, extra, style, show, x, y, width, height, center, _multithreaded, data);
+End;
+
+Constructor TWin32Window.Create(wndclass, title : String; extra, style : DWord; show, x, y, width, height : Integer; center, _multithreaded : Boolean);
+
+Begin
+ internal_create(wndclass, title, extra, style, show, x, y, width, height, center, _multithreaded, Nil);
+End;
+
+Destructor TWin32Window.Destroy;
+
+Begin
+ close;
+ Inherited Destroy;
+End;
+
+Procedure TWin32Window.cursor(flag : Boolean);
+
+Begin
+ If flag Then
+ Begin
+ SetClassLong(m_window, GCL_HCURSOR, LoadCursor(0, IDC_ARROW));
+ End
+ Else
+ Begin
+ SetClassLong(m_window, GCL_HCURSOR, 0);
+ End;
+ SendMessage(m_window, WM_SETCURSOR, 0, 0);
+End;
+
+Procedure TWin32Window.resize(width, height : Integer);
+
+Var
+ window_rectangle : RECT;
+ rectangle : RECT;
+
+Begin
+ GetWindowRect(m_window, window_rectangle);
+ With rectangle Do
+ Begin
+ left := 0;
+ top := 0;
+ right := width;
+ bottom := height;
+ End;
+ AdjustWindowRectEx(rectangle, m_style, False, m_extra);
+ SetWindowPos(m_window, HWND_TOP, window_rectangle.left,
+ window_rectangle.top, rectangle.right - rectangle.left,
+ rectangle.bottom - rectangle.top, 0);
+ {
+ todo: detect if the window is resized off the screen and let windows reposition it correctly... ?
+ }
+End;
+
+Procedure TWin32Window.update(force : Boolean);
+
+Var
+ message : MSG;
+
+Begin
+ If (Not m_managed) And (Not force) Then
+ Exit;
+ If Not m_multithreaded Then
+ Begin
+ While PeekMessage(message, m_window, 0, 0, PM_REMOVE) Do
+ Begin
+ TranslateMessage(message);
+ DispatchMessage(message);
+ End;
+ End
+ Else
+ Sleep(0);
+End;
+
+Procedure TWin32Window.update; {force = False}
+
+Begin
+ update(False);
+End;
+
+Function TWin32Window.handle : HWND;
+
+Begin
+ handle := m_window;
+End;
+
+Function TWin32Window.thread : DWord;
+
+Begin
+ If m_multithreaded Then
+ thread := m_id
+ Else
+ thread := GetCurrentThreadId;
+End;
+
+Function TWin32Window.managed : Boolean;
+
+Begin
+ managed := m_managed;
+End;
+
+Function TWin32Window.multithreaded : Boolean;
+
+Begin
+ multithreaded := m_multithreaded;
+End;
+
+Function WndProcSingleThreaded(hWnd : HWND; message : UINT; wParam : WPARAM; lParam : LPARAM) : LRESULT; StdCall;
+
+Begin
+ Case message Of
+ WM_CLOSE : Begin
+ LOG('TWin32Window WM_CLOSE');
+ Halt(0);
+ End;
+ Else
+ WndProcSingleThreaded := DefWindowProc(hWnd, message, wParam, lParam);
+ End;
+End;
+
+Function WndProcMultiThreaded(hWnd : HWND; message : UINT; wParam : WPARAM; lParam : LPARAM) : LRESULT; StdCall;
+
+Begin
+ WndProcMultiThreaded := 0;
+ Case message Of
+ WM_DESTROY : Begin
+ LOG('TWin32Window WM_DESTROY');
+ PostQuitMessage(0);
+ End;
+ WM_CLOSE : Begin
+ LOG('TWin32Window WM_CLOSE');
+ Halt(0);
+ End;
+ Else
+ WndProcMultiThreaded := DefWindowProc(hWnd, message, wParam, lParam);
+ End;
+End;
+
+Procedure TWin32Window.internal_create(wndclass, title : String; extra, style : DWord; show, x, y, width, height : Integer; center, _multithreaded : Boolean; data : Pointer);
+
+Var
+ program_instance{, library_instance} : DWord;
+ rectangle : RECT;
+ display_width, display_height : Integer;
+ wc : WNDCLASSEX;
+
+Begin
+ LOG('creating managed window');
+ defaults;
+ m_multithreaded := _multithreaded;
+ wndclass := wndclass + #0;
+ title := title + #0;
+ Try
+ program_instance := GetModuleHandle(Nil);
+{ library_instance := program_instance;}
+ wc.cbSize := SizeOf(WNDCLASSEX);
+ wc.hInstance := program_instance;
+ wc.lpszClassName := @wndclass[1];
+ wc.style := CS_VREDRAW Or CS_HREDRAW;
+ wc.hIcon := 0{LoadIcon(library_instance, 'IDI_PTC_ICON')};
+ wc.hIconSm := 0;
+ wc.lpszMenuName := Nil;
+ wc.cbClsExtra := 0;
+ wc.cbWndExtra := 0;
+ wc.hbrBackground := 0;{(HBRUSH) GetStockObject(BLACK_BRUSH)}
+ If multithreaded Then
+ wc.lpfnWndProc := @WndProcMultiThreaded
+ Else
+ wc.lpfnWndProc := @WndProcSingleThreaded;
+ wc.hCursor := LoadCursor(0, IDC_ARROW);
+ RegisterClassEx(wc);
+ With rectangle Do
+ Begin
+ left := 0;
+ top := 0;
+ right := width;
+ bottom := height;
+ End;
+ AdjustWindowRectEx(rectangle, style, False, extra);
+ If center Then
+ Begin
+ LOG('centering window');
+ display_width := GetSystemMetrics(SM_CXSCREEN);
+ display_height := GetSystemMetrics(SM_CYSCREEN);
+ x := (display_width - (rectangle.right - rectangle.left)) Div 2;
+ y := (display_height - (rectangle.bottom - rectangle.top)) Div 2;
+ End;
+ m_name := wndclass;
+ m_title := title;
+ m_extra := extra;
+ m_style := style;
+ m_show := show;
+ m_x := x;
+ m_y := y;
+ m_width := rectangle.right - rectangle.left;
+ m_height := rectangle.bottom - rectangle.top;
+ m_data := data;
+ If multithreaded Then
+ Begin
+ {...}
+ End
+ Else
+ Begin
+ 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);
+ If Not IsWindow(m_window) Then
+ Raise TPTCError.Create('could not create window');
+ ShowWindow(m_window, m_show);
+ SetFocus(m_window);
+ SetActiveWindow(m_window);
+ SetForegroundWindow(m_window);
+ End;
+ Except
+ On error : TPTCError Do
+ Raise TPTCError.Create('could not create window', error);
+ End;
+End;
+
+Procedure TWin32Window.defaults;
+
+Begin
+ m_window := 0;
+ m_event := 0;
+ m_thread := 0;
+ m_id := 0;
+ m_name := '';
+ m_title := '';
+ m_extra := 0;
+ m_style := 0;
+ m_show := 0;
+ m_x := 0;
+ m_y := 0;
+ m_width := 0;
+ m_height := 0;
+ m_data := Nil;
+ m_managed := True;
+ m_multithreaded := False;
+End;
+
+Procedure TWin32Window.close;
+
+Begin
+ If Not m_managed Then
+ Begin
+ LOG('detaching from user managed window');
+ m_window := 0;
+ End
+ Else
+ Begin
+ LOG('closing managed window');
+ If m_multithreaded Then
+ Begin
+ If (m_thread <> 0) And IsWindow(m_window) Then
+ Begin
+ PostMessage(m_window, WM_DESTROY, 0, 0);
+ WaitForSingleObject(m_thread, INFINITE);
+ End;
+ If m_event <> 0 Then
+ CloseHandle(m_event);
+ If m_thread <> 0 Then
+ CloseHandle(m_thread);
+ SetPriorityClass(GetCurrentProcess, NORMAL_PRIORITY_CLASS);
+ End
+ Else
+ If (m_window <> 0) And IsWindow(m_window) Then
+ DestroyWindow(m_window);
+ m_window := 0;
+ m_event := 0;
+ m_thread := 0;
+ m_id := 0;
+ UnregisterClass(PChar(m_name), GetModuleHandle(Nil));
+ End;
+End;
+
+Class Procedure TWin32Window.ThreadFunction(owner : TWin32Window);
+
+Var
+ message : MSG;
+
+Begin
+ With owner Do
+ Begin
+ 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);
+ If IsWindow(m_window) Then
+ Begin
+ ShowWindow(m_window, m_show);
+ SetFocus(m_window);
+ SetForegroundWindow(m_window);
+ SetEvent(m_event);
+ While GetMessage(message, 0, 0, 0) = True Do
+ Begin
+ TranslateMessage(message);
+ DispatchMessage(message);
+ End;
+ End
+ Else
+ SetEvent(m_event);
+ End;
+End;
diff --git a/packages/ptc/src/win32/base/windowd.inc b/packages/ptc/src/win32/base/windowd.inc
new file mode 100644
index 0000000000..d7e7f9d8ae
--- /dev/null
+++ b/packages/ptc/src/win32/base/windowd.inc
@@ -0,0 +1,58 @@
+{
+ Free Pascal port of the OpenPTC C++ library.
+ Copyright (C) 2001-2003 Nikolay Nikolov (nickysn@users.sourceforge.net)
+ Original C++ version by Glenn Fiedler (ptc@gaffer.org)
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+}
+
+Type
+ TWin32Window = Class(TObject)
+ Private
+ Procedure internal_create(wndclass, title : String; extra, style : DWord; show, x, y, width, height : Integer; center, _multithreaded : Boolean; data : Pointer);
+
+ Procedure defaults;
+ Procedure close;
+ Class Procedure ThreadFunction(owner : TWin32Window);
+{ Class Function WndProcSingleThreaded(hWnd : HWND; message : UINT; wParam : WPARAM; lParam : LPARAM) : LRESULT; StdCall;
+ Class Function WndProcMultiThreaded(hWnd : HWND; message : UINT; wParam : WPARAM; lParam : LPARAM) : LRESULT; StdCall;}
+ m_window : HWND;
+ m_event : THANDLE;
+ m_thread : THANDLE;
+ m_id : DWord;
+ m_name : AnsiString;
+ m_title : AnsiString;
+ m_extra : DWord;
+ m_style : DWord;
+ m_show : Integer;
+ m_x, m_y : Integer;
+ m_width, m_height : Integer;
+ m_data : Pointer;
+ m_managed : Boolean;
+ m_multithreaded : Boolean;
+ Public
+ Constructor Create(window : HWND);
+ Constructor Create(wndclass, title : String; extra, style : DWord; show, x, y, width, height : Integer; center, _multithreaded : Boolean; data : Pointer);
+ Constructor Create(wndclass, title : String; extra, style : DWord; show, x, y, width, height : Integer; center, _multithreaded : Boolean);
+ Destructor Destroy; Override;
+ Procedure cursor(flag : Boolean);
+ Procedure resize(width, height : Integer);
+ Procedure update(force : Boolean);
+ Procedure update; {force = False}
+ Function handle : HWND;
+ Function thread : DWord;
+ Function managed : Boolean;
+ Function multithreaded : Boolean;
+ End;
diff --git a/packages/ptc/src/win32/base/windows.ico b/packages/ptc/src/win32/base/windows.ico
new file mode 100644
index 0000000000..3480614b36
--- /dev/null
+++ b/packages/ptc/src/win32/base/windows.ico
Binary files differ
View Lorry Controller Status