/
castlewindow_winapi.inc
2100 lines (1823 loc) · 80.4 KB
/
castlewindow_winapi.inc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{%MainUnit ../castlewindow.pas}
{
Copyright 2001-2024 Michalis Kamburelis.
This file is part of "Castle Game Engine".
"Castle Game Engine" is free software; see the file COPYING.txt,
included in this distribution, for details about the copyright.
"Castle Game Engine" 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.
----------------------------------------------------------------------------
}
{ CastleWindow backend using WinAPI, Windows-only.
TODO:
- Alt key presses are not perfectly detected.
Is it even possible to cleanly catch VK_Alt key press in WinAPI?
We would have to catch sys_keydown message but then we also
block using standard Alt+F4 or Alt+Space? Another trouble:
if you enter system menu by Alt+Down, we will not get Alt+Up?
- Implement MainMenu.Enabled.
Note: We use Unicode version of WinAPI (W suffix) throughout the code.
- Why?
Following https://stackoverflow.com/questions/33714546/winapi-unicode-and-ansi-functions ,
this is available on all Windowses after Windows 95, 98 and ME,
and it is advised to use now (as the "A" routines just call "W" routines doing conversion underneath),
and using it is easier on Delphi (where String = UnicodeString),
and using it with both FPC and Delphi makes code simpler.
- Note: LCL win32 widgetset (used on 64-bit Windows too) still uses ANSI.
}
{$ifdef USE_EGL}
{$I castlewindow_egl.inc}
{$else}
{$I castlewindow_wgl.inc}
{$endif}
{$ifdef read_interface_uses}
{ note: this unit's definitions conflict with other definitions used in this file
But we need it for RegisterDeviceNotification, therefore adding it to the very
first position in the uses list to be overwritten by subsequent used units }
{$ifdef FPC}
JwaWinUser, JwaDbt,
{$else}
Winapi.Messages, Character,
{$endif}
Imm,
{ /note }
Windows, CommDlg,
{$endif}
{$ifdef read_implementation_uses}
CastleInternalWindowModes, CastleMessages, CastleJoysticks, CastleUnicode,
{$endif}
{$ifdef read_window_interface}
private
h_Dc: HDC;
h_Wnd: HWND;
{ InCloseBackend = true means we are currently inside CloseBackend call.
Useful -- see at WM_ACTIVATE. }
InCloseBackend: boolean;
EnableUpdatesFromWindowProc, DisableUpdatesFromWindowProc: Cardinal;
VK_LeftBracket_Exists,
VK_RightBracket_Exists,
VK_Apostrophe_Exists,
VK_Semicolon_Exists,
VK_Slash_Exists,
VK_BackQuote_Exists,
VK_BackSlash_Exists: boolean;
VK_LeftBracket,
VK_RightBracket,
VK_Apostrophe,
VK_Semicolon,
VK_Slash,
VK_BackQuote,
VK_BackSlash: Byte;
function WindowProc(uMsg: UINT; wParm: WPARAM; lParm: LPARAM): LRESULT;
{ convert virtual key code (VK_xxx) to TKey. Returns keyNone if no conversion
available. }
function VirtualKeyToKey(VirtualKey: Byte): TKey;
{$endif read_window_interface}
{$ifdef read_application_interface}
private
{ Should we do ChangeDisplaySettings(nil, 0) when Destroy? }
DisplaySettingsChanged: boolean;
WndClassName: UnicodeString;
{ A private array, initialized in CreateBackend.
Having all cursor handles loaded makes sure that WM_SETCURSOR is able to
use predefined HCURSOR values and so is fast. SetCursor is guaranteed
by WinAPI to return fast if called with already used cursor.
For mcDefault, value in this array is undefined.
(but 0 in practice, for now).
For mcNone and CursorHandles, CursorHandle is guaranteed 0
(this is what SetCursor always accepts as invisible cursor). }
CursorHandles: array [TMouseCursor] of record
Handle: HCURSOR;
end;
fappActive: boolean;
procedure SetAppActive(value: boolean);
property appActive: boolean read fappActive write SetAppActive;
{$endif read_application_interface}
{$ifdef read_implementation}
{$I castlewindow_winapi_menu.inc}
{$I castlewindow_winapi_sendinput.inc}
{ Describe ChangeDisplaySettings result. }
function DispChangeToStr(L: LongInt): String;
begin
case L of
DISP_CHANGE_SUCCESSFUL: Result := 'DISP_CHANGE_SUCCESSFUL';
DISP_CHANGE_RESTART: Result := 'DISP_CHANGE_RESTART';
DISP_CHANGE_BADFLAGS: Result := 'DISP_CHANGE_BADFLAGS';
DISP_CHANGE_FAILED: Result := 'DISP_CHANGE_FAILED';
DISP_CHANGE_BADMODE: Result := 'DISP_CHANGE_BADMODE';
DISP_CHANGE_NOTUPDATED: Result := 'DISP_CHANGE_NOTUPDATED';
else Result := IntToStr(L);
end;
end;
{ WMSizing ------------------------------------------------------------------- }
type
{ Handling WMSizing message is a way to force minimum/maximum form
sizes under WinAPI. }
TWMSizing = record
Msg: Cardinal; {< wm_SIZING }
fwSide: Longint; {< const WMSZ_xxx }
lprc: PRect; {< rectangle with window sizes }
Result: LongBool; {< should return longbool(true) }
end;
procedure WMSizingHandler(var Msg:TWMSizing;
const minWidth, minHeight, maxWidth, maxHeight:integer); overload;
var
w, h:integer;
begin
assert(minWidth<=maxWidth);
assert(minHeight<=maxHeight);
with msg.lprc^ do
begin
w := right-left;
if w<minWidth then right := left+minWidth else
if w>maxWidth then right := left+maxWidth;
h := bottom-top;
if h<minHeight then bottom := top+minHeight else
if h>maxHeight then bottom := top+maxHeight;
end;
msg.result := true;
end;
function WMSizingHandler(const lParm:LPARAM; const wParm:WPARAM;
const minWidth, minHeight, maxWidth, maxHeight:integer):LRESULT; overload;
var
msg: TWMSizing;
begin
msg.Msg := WM_SIZING;
msg.fwSide := wParm;
msg.lprc := PRect(lParm);
WMSizingHandler(msg, minWidth, minHeight, maxWidth, maxHeight);
result := LRESULT(msg.Result);
end;
{ TCastleWindow ------------------------------------------------- }
const
{ Some constants missing from FPC's Windows unit. }
VK_OEM_1 = $BA;
VK_OEM_PLUS = $BB;
VK_OEM_COMMA = $BC;
VK_OEM_MINUS = $BD;
VK_OEM_PERIOD = $BE;
VK_OEM_2 = $BF;
VK_OEM_3 = $C0;
VK_OEM_4 = $DB;
VK_OEM_5 = $DC;
VK_OEM_6 = $DD;
VK_OEM_7 = $DE;
VK_OEM_8 = $DF;
VK_OEM_102 = $E2;
{ convert virtual key code (VK_xxx) to TKey. Returns keyNone if no conversion
available. }
function TCastleWindow.VirtualKeyToKey(VirtualKey: Byte): TKey;
var
VirtualKeyToKeyResult: TKey absolute Result;
function VK_Stored(VK_Exists: boolean; VK_Value: Byte; KeyValue: TKey): boolean;
begin
Result := VK_Exists and (VirtualKey = VK_Value);
if Result then
VirtualKeyToKeyResult := KeyValue;
end;
begin
{ Tests: InfoWrite(Format('key %d', [VirtualKey])); }
case VirtualKey of
VK_BACK: Result := keyBackSpace;
VK_TAB: Result := keyTab;
VK_RETURN: Result := keyEnter;
VK_SHIFT: Result := keyShift;
VK_CONTROL: Result := keyCtrl;
VK_MENU: Result := keyAlt;
VK_ESCAPE: Result := keyEscape;
VK_SPACE: Result := keySpace;
VK_PRIOR: Result := keyPageUp;
VK_NEXT: Result := keyPageDown;
VK_END: Result := keyEnd;
VK_HOME: Result := keyHome;
VK_LEFT: Result := keyArrowLeft;
VK_UP: Result := keyArrowUp;
VK_RIGHT: Result := keyArrowRight;
VK_DOWN: Result := keyArrowDown;
VK_INSERT: Result := keyInsert;
VK_DELETE: Result := keyDelete;
VK_ADD: Result := keyNumpadPlus;
VK_SUBTRACT: Result := keyNumpadMinus;
VK_SNAPSHOT: Result := keyPrintScreen;
VK_NUMLOCK: Result := keyNumLock;
VK_SCROLL: Result := keyScrollLock;
VK_CAPITAL: Result := keyCapsLock;
VK_PAUSE: Result := keyPause;
VK_OEM_COMMA: Result := keyComma;
VK_OEM_PERIOD: Result := keyPeriod;
VK_NUMPAD0: Result := keyNumpad0;
VK_NUMPAD1: Result := keyNumpad1;
VK_NUMPAD2: Result := keyNumpad2;
VK_NUMPAD3: Result := keyNumpad3;
VK_NUMPAD4: Result := keyNumpad4;
VK_NUMPAD5: Result := keyNumpad5;
VK_NUMPAD6: Result := keyNumpad6;
VK_NUMPAD7: Result := keyNumpad7;
VK_NUMPAD8: Result := keyNumpad8;
VK_NUMPAD9: Result := keyNumpad9;
VK_CLEAR: Result := keyNumpadBegin;
VK_MULTIPLY: Result := keyNumpadMultiply;
VK_DIVIDE: Result := keyNumpadDivide;
VK_OEM_MINUS: Result := keyMinus;
VK_OEM_PLUS: Result := keyPlus;
Ord('0') .. Ord('9'): Result := TKey(Ord(key0) + Ord(VirtualKey) - Ord('0'));
Ord('A') .. Ord('Z'): Result := TKey(Ord(keyA) + Ord(VirtualKey) - Ord('A'));
VK_F1 .. VK_F12 : Result := TKey(Ord(keyF1) + Ord(VirtualKey) - Ord(VK_F1));
else
if not VK_Stored(VK_LeftBracket_Exists , VK_LeftBracket , keyLeftBracket ) then
if not VK_Stored(VK_RightBracket_Exists, VK_RightBracket, keyRightBracket) then
if not VK_Stored(VK_Apostrophe_Exists , VK_Apostrophe , keyApostrophe ) then
if not VK_Stored(VK_Semicolon_Exists , VK_Semicolon , keySemicolon ) then
if not VK_Stored(VK_Slash_Exists , VK_Slash , keySlash ) then
if not VK_Stored(VK_BackQuote_Exists , VK_BackQuote , keyBackQuote ) then
if not VK_Stored(VK_BackSlash_Exists , VK_BackSlash , keyBackSlash ) then
Result := keyNone;
end;
{ Note that CastleWindow WinAPI will never generate Press/Release with these keys:
keyNumpadEnd;
keyNumpadDown;
keyNumpadPageDown;
keyNumpadLeft;
keyNumpadRight;
keyNumpadHome;
keyNumpadUp;
keyNumpadPageUp;
keyNumpadInsert;
keyNumpadDelete;
keyNumpadEnter;
because (as far as I can see) they are undistinguishable from normal,
non-numpad key codes under WinAPI.
Note that it seems that VK_SNAPSHOT (keyPrintScreen) is never passed to
WM_KEYDOWN (although it's passed to WM_KEYUP; but there we ignore it,
because in our Keys[] table it's already up).
So you will never get KeyDown/Up with keyPrintScreen. }
end;
function TryHandlingMessage(hWnd: HWND; uMsg: UINT; wParm: WPARAM; lParm: LPARAM): boolean;
var
Window: TCastleWindow;
begin
Window := TCastleWindow(GetWindowLongPtr(hWnd, GWL_USERDATA));
Result := Application.FindWindow(Window) >= 0;
if Result then
Window.WindowProc(uMsg, wParm, lParm);
end;
function WndProc(hWnd: HWND; uMsg: UINT; wParm: WPARAM; lParm: LPARAM) :LRESULT; stdcall;
var
Window: TCastleWindow;
begin
Window := TCastleWindow(GetWindowLongPtr(hWnd, GWL_USERDATA));
{ Wszystkie hwnd jakie tu beda wpadac to beda nasze okna
(it's only different for a plugin, but right now the plugin uses only TryHandlingMessage,
not this). Ale zanim
ustawimy oknu SetWindowLongPtr (GetWindowLongPtr bedzie do tego czasu zwracac 0)
ono juz dostaje jakies messagy - WM_CREATE i inne.
Mozemy je spokojnie zignorowac.
Co wiecej jednak, moze tak byc ze Window <> nil ale wskazuje na okienko
ktore juz jest zamkniete (a moze nawet na obiekt ktory juz zostal
zwolniony z pamieci !). Dlaczego tak jest, patrz komentarz na poczatku
castlewindow_winsystem.inc. Wiec sprawdzamy tutaj czy Window jest na liscie
Application.OpenWindows .
Moreover, temporary windows created by CreateTemporaryWindow in
SetPixelFormat_WGLChoose also get here (as they use our
Application.wndClassName). They don't set Get/SetWindowLongPtr, so Window here
will be @nil in this case. }
if Application.FindWindow(Window) >= 0 then
result := Window.WindowProc(uMsg, wParm, lParm)
else
result := DefWindowProcW(hWnd, uMsg, wParm, lParm);
end;
function TCastleWindow.WindowProc(uMsg: UINT; wParm: WPARAM; lParm: LPARAM): LRESULT;
{ Note: the following Windows events may be called from CloseBackend
(so they probably should check InCloseBackend):
WM_WINDOWPOSCHANGING
WM_WINDOWPOSCHANGED
WM_NCACTIVATE
WM_ACTIVATE
WM_ACTIVATEAPP
WM_KILLFOCUS
WM_DESTROY
WM_NCDESTROY
WM_SIZE (yes, tested on Windows 2000 Prof, when running my progs
with --fullscreen-custom, e.g. glinformation --fullscreen-custom 640x480
or glplotter --fullscreen-custom 640x480)
}
procedure MaybeCapture;
{ mouse down occurred; so capture the mouse if it's not captured already }
begin
if GetCapture <> H_Wnd then SetCapture(H_Wnd);
end;
procedure MaybeRelease;
{ mouse up occurred; release capture if all mouse buttons are now up }
begin
if (mousePressed=[]) and (GetCapture = H_Wnd) then ReleaseCapture;
end;
type
{ This is useful to deconstruct WParam and LParam.
It will work faster than any LoWord/HiWord functions in Windows unit,
it avoids any range-check errors,
it allows to specify signedness of values as you wish. }
TWinParam = packed record
case Integer of
0:(Signed: LongInt {$if defined(cpu64)}; Dummy: UInt32 {$endif});
1:(LoWord, HiWord: Word);
2:(LoSmallint, HiSmallint: Smallint);
3:(LowestByte, LowerByte, HigherByte, HighestByte: byte);
end;
function InterceptedSystemKey(key: integer): boolean;
begin
Result := { TODO-alt: (key = VK_Alt) or }(key = VK_F10)
end;
{ Convert WM_CHAR's wParam value to a String in UTF-8 encoding,
corresponding to key pressed. Empty if none. }
function ConvertWmCharToString(const CharMsgWParam: WPARAM): String;
begin
{ According to WM_CHAR docs, wParam is already a single character in UTF-16 encoding.
This is true if we peeked it using PeekMessageW, not PeekMessage.
So just convert it using UTF8Encode.
Notes:
- Doing "Exit(UnicodeToUTF8(WParm))" also seems to work for Polish chars.
But it's not necessarily correct, I think: UTF-16 character number
is not necessarily equal to just Unicode number.
- At one point we did here
MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, @CharMsgWParam, SizeOf(CharMsgWParam), ...)
But this was a hack: we treated CharMsgWParam as string
(4 bytes, so 2 characters) in local Windows ANSI code page.
We then hackishly ignored MultiByteToWideChar result,
and used first returned WideChar.
}
{$ifdef FPC}
Exit(UTF8Encode(WideChar(CharMsgWParam)));
{$else}
Exit(WideChar(CharMsgWParam));
{$endif}
end;
{ Handle WinAPI WM_KEYDOWN message by calling DoKeyDown method.
We also handle (peek and remove) WM_CHAR message here. }
procedure Handle_WM_KEYDOWN;
{ Note that WM_KEYDOWN is repeated when the user holds the key down.
The frequency of "key repeat" depends on user settings.
And... that's completely OK. We still pass each WM_KEYDOWN to DoKeyDown.
This way our API (TCastleUserInterface.Press, TCastleWindow.OnPress)
will generate repeated key presses.
This is documented and desired (e.g. for implementing UI like edit box).
User can check TInputPressRelease.KeyRepeated that is calculated
elsewhere. (We could also calculate TInputPressRelease.KeyRepeated here,
looking at KEY_ALREADY_DOWN bit in lParm, but it's not needed for now.)
}
var
Key: TKey;
CharMsg: TMsg;
KeyString: String;
begin
{ WM_CHAR is placed in our message queue by TranslateMessage.
Always in WM_KEYDOWN we do this PeekMessageW(..., WM_CHAR, WM_CHAR, PM_REMOVE).
This means that now we have
1. no WM_CHAR messages in our message queue (which means that this
WM_KEYDOWN message is not translatable as WM_CHAR) OR
2. we have exactly one WM_CHAR message in our queue, and this is WM_CHAR
message corresponding to current WM_KEYDOWN message.
Note PeekMessageW, not PeekMessage.
This is necessary to receive UTF-16 for e.g. Polish chars.
Otherwise WM_CHAR gets characters in ANSI encoding.
}
if PeekMessageW({$ifdef FPC}@{$endif}CharMsg, h_Wnd, WM_CHAR, WM_CHAR, PM_REMOVE) then
KeyString := ConvertWmCharToString(CharMsg.wParam)
else
KeyString := '';
Key := VirtualKeyToKey(wParm);
{ We cannot depend that VK_OEM_4 is always "[" and VK_OEM_6 is always "]",
see http://www.tronan.com/macromachine/scripthelp/VK.htm.
On non-US keyboards, other keys may correspond to them.
So below we do a little trick: we check which virtual key corresponds to
left/right brackets, and we remember it. If my VirtualKeyToKey returned
keyNone for this virtual key, then we can safely assume that in the future
(e.g. for next WM_KEYUP for this key) this virtual key always corresponds
to left/right bracket. }
if Key = keyNone then
begin
if KeyString = '[' then
begin VK_LeftBracket_Exists := true; VK_LeftBracket := wParm; Key := keyLeftBracket ; end
else if KeyString = ']' then
begin VK_RightBracket_Exists := true; VK_RightBracket := wParm; Key := keyRightBracket; end
else if KeyString = '''' then
begin VK_Apostrophe_Exists := true; VK_Apostrophe := wParm; Key := keyApostrophe ; end
else if KeyString = ';' then
begin VK_Semicolon_Exists := true; VK_Semicolon := wParm; Key := keySemicolon ; end
else if KeyString = '/' then
begin VK_Slash_Exists := true; VK_Slash := wParm; Key := keySlash ; end
else if KeyString = '`' then
begin VK_BackQuote_Exists := true; VK_BackQuote := wParm; Key := keyBackQuote ; end
else if KeyString = '\' then
begin VK_BackSlash_Exists := true; VK_BackSlash := wParm; Key := keyBackSlash ; end;
end;
{ Fix some cases when KeyString should better correspond to Key }
if (KeyString = '') and (Key = keyDelete) then
KeyString := CharDelete;
if (Key <> keyNone) or (KeyString <> '') then DoKeyDown(Key, KeyString);
end;
{ Handle WinAPI WM_KEYUP message by calling DoKeyUp method. }
procedure Handle_WM_KEYUP;
var
Key: TKey;
begin
Key := VirtualKeyToKey(wParm);
if Key <> keyNone then DoKeyUp(Key);
end;
{ Handle WM_CHAR that arrived without WM_KEYDOWN.
- In case of input in Western languages (English, Polish etc.):
This should never happen.
The only way we can get WM_CHAR message is when we get WM_KEYDOWN
message and TranslateMessage (called from castlewindow_winsystem.inc)
translates it to WM_CHAR message.
But actually always in WM_KEYDOWN handler we do
PeekMessageW(..., WM_CHAR, WM_CHAR, PM_REMOVE) so all WM_CHAR messages
are removed from queue immediately after they are put there by TranslateMessage.
So no WM_CHAR message should be ever dispatched by DispatchMessage.
So no WM_CHAR message should ever get here.
- In case of Chinese, where input arrives only through WM_CHAR,
this can definitely happen.
For Chinese you have a special window that allows to compose Chinese characters.
Looks like they don't result in WM_KEYDOWN, only WM_CHAR.
Tested with simplified Chinese input on Windows 10.
Note: It does *not* make WM_UNICHAR (regardless if we register using RegisterClassW or ANSI version).
- A minor thing about Wine compatibility:
It seems wine-1.5.30-1 lets WM_CHAR arrive without WM_KEYDOWN
in one special case too: when pressing escape to unfocus menu bar.
}
procedure Handle_WM_CHAR;
var
KeyString: String;
begin
KeyString := ConvertWmCharToString(WParm);
if KeyString <> '' then
DoKeyDown(keyNone, KeyString);
WritelnLog('Received WM_CHAR. Test information for https://github.com/castle-engine/castle-engine/issues/159 : WParam ' + IntToStr(WParm) + ' string: ' + {$ifdef FPC}UTF8ToHtmlEntities({$endif}KeyString{$ifdef FPC}){$endif});
end;
{ Handle WM_UNICHAR that reports a key press as 32-bit Unicode character.
WM_UNICHAR seems to never happen in practice.
See also
https://stackoverflow.com/questions/378296/why-is-my-wm-unichar-handler-never-called
https://stackoverflow.com/questions/5844689/winapi-how-to-process-keyboard-input-in-custom-edit-control
"""
- WM_KEYDOWN is sent to the window with the focus when a non-system key has been pressed. When the message is translated by the TranslateMessage function, a WM_CHAR message is sent to the window.
- WM_CHAR uses UTF-16.
- WM_UNICHAR is similat to WM_CHAR, except that it uses UTF-32.
It's purpose is to send/post Unicode characters to ANSI windows.
If the window is ANSI (created with CreateWindowA), when WM_CHAR is generated.
If it is Unicode (created with CreateWindowW) then WM_UNICHAR is generated.
So your control should probably handle both.
Other applications can send us WM_UNICHAR, according to WinAPI docs.
"""
Testing in practice: I didn't find a way to cause WM_UNICHAR in either
ANSI or Unicode window (created with CreateWindowExW).
}
procedure Handle_WM_UNICHAR;
var
KeyString: String;
begin
WritelnLog('Received WM_UNICHAR. This may work but is UNTESTED in CGE (please post a report if you know how to cause this message). Test information for https://github.com/castle-engine/castle-engine/issues/159 : WParam ' + IntToStr(WParm));
if wParm <> UNICODE_NOCHAR then // ignore UNICODE_NOCHAR, which is used only to test do we handle WM_UNICHAR
begin
{ Treat UTF-32 character code as just Unicode code.
This is the same: https://en.wikipedia.org/wiki/UTF-32,
"""Each 32-bit value in UTF-32 represents one Unicode code point and is exactly equal to that code point's numerical value. """
}
KeyString := {$ifdef FPC}UnicodeToUTF8(WParm){$else}ConvertFromUtf32(WParm){$endif};
if KeyString <> '' then
DoKeyDown(keyNone, KeyString);
end;
end;
function Handle_IME: Boolean;
function ToPoint(const V: TVector2): TPoint;
begin
Result.X := Floor(V.X);
Result.Y := Floor(Container.PixelsHeight - V.Y);
end;
function GetCaretPos(var CaretPos: TPoint): Boolean;
var
CastleEdit: TCastleEdit;
CaretShift: Single;
S: String;
begin
Result := false;
{ TODO: Handles all input controls, not just TCastleEdit }
if (Container.Focus.Count <> 0) and
(Container.Focus.Last is TCastleEdit) then
begin
CastleEdit := Container.Focus.Last as TCastleEdit;
S := CastleEdit.Text;
if CastleEdit.PasswordChar <> #0 then
S := StringOfChar(CastleEdit.PasswordChar, Length(S));
CaretShift := CastleEdit.Font.TextWidth(S);
CaretPos := ToPoint(CastleEdit.LocalToContainerPosition(Vector2(CaretShift / CastleEdit.UIScale, 0)));
Result := true;
end;
end;
var
vhIMC: HIMC;
vSize: Integer;
vBuffer: TBytes;
KeyString: UnicodeString;
//vLogFont: TLogFont;
vCF: TCompositionForm;
Pt: TPoint;
begin
Result := false;
case uMsg of
WM_IME_STARTCOMPOSITION, WM_IME_ENDCOMPOSITION:
begin
{ adjusted composition window's position and font/caret size }
vhIMC := ImmGetContext(h_Wnd);
if vhIMC = 0 then Exit;
try
ImmSetOpenStatus(vhIMC, true);
{ TODO: Set the LogFont size }
{
ImmGetCompositionFont(vhIMC, @vLogFont);
vLogFont.lfHeight := Font.Height;
ImmSetCompositionFont(vhIMC, @vLogFont);
}
if not GetCaretPos(Pt) then
begin
GetCursorPos(Pt);
ScreenToClient(h_Wnd, Pt);
Pt.Offset(0, 25);
end;
vCF.ptCurrentPos := Pt;
vCF.dwStyle := CFS_RECT;
vCF.rcArea := TRect.Create(0, 0, Width, Height);
ImmSetCompositionWindow(vhIMC, @vCF);
finally
ImmReleaseContext(h_Wnd, vhIMC);
end;
{ About return value:
Note that WM_IME_STARTCOMPOSITION, WM_IME_ENDCOMPOSITION must return false.
Because we do not implement the IME input window by itself, we return false to let the system IME handle it by itself.
We only tell the system where the IME window needs to be displayed, font information, etc.
Why do we handle WM_IME_ENDCOMPOSITION at all (that is usually when IME window is hidden)?
Since the IME can be developed by any company, sometimes the IME window will appear prematurely at the last closed position.
So deal with WM_IME_ENDCOMPOSITION to avoid This case.
}
end;
WM_IME_COMPOSITION:
begin
if (LParm and GCS_RESULTSTR) <> 0 then
begin
vhIMC := ImmGetContext(h_Wnd);
if vhIMC = 0 then Exit;
try
vSize := ImmGetCompositionStringW(vhIMC, GCS_RESULTSTR, nil, 0);
if vSize > 0 then
begin
SetLength(vBuffer, vSize);
ImmGetCompositionStringW(vhIMC, GCS_RESULTSTR, @vBuffer[0], vSize);
KeyString := WideStringOf(vBuffer);
if KeyString <> '' then
begin
DoKeyDown(keyNone, Utf16ToString(KeyString));
end;
end;
finally
ImmReleaseContext(h_Wnd, vhIMC);
end;
Result := true;
end;
end;
end;
end;
procedure HandleMouseDown(const Button: TCastleMouseButton);
begin
MaybeCapture;
DoMouseDown(LeftTopToCastle(
TWinParam(lParm).LoSmallint,
TWinParam(lParm).HiSmallint), Button, 0);
end;
procedure HandleMouseUp(const Button: TCastleMouseButton);
begin
DoMouseUp(LeftTopToCastle(
TWinParam(lParm).LoSmallint,
TWinParam(lParm).HiSmallint), Button, 0);
MaybeRelease;
end;
var
DoEnableUpdatesFromWindowProc, DoDisableUpdatesFromWindowProc: boolean;
begin
Result := 0;
{ generalnie chcemy przepuszczac SYSKEY* do DefaultWndProc ktore moze
wtedy np. na Alt+F4 zrobic nam close albo na Alt+spacja otworzyc
nam system menu itp. To wszystko sa fajne rzeczy i nie chce ich blokowac
przechwytujac zawsze zdarzenia SYSKEY*, tym samym rezygnuje z przetwarzania
kiedywkolwiek sekwencji klawiszy w rodzaju Alt+F4.
Ale jednak czasem chce przechwycic zdarzenia SYSKEY* zeby obsluzyc wlasne
klawisze. Wiec niektore klawisze przechwytujemy od systemu operacyjnego.
(normalnie Alt i F10 powoduja wejscie w menu). Wiec wtedy zmieniam uMsg z
SYSKEY* na KEY* (korzystajac z tego ze te zdarzenia maja taki sam format
dla wParm i lParm). }
if (uMsg = WM_SYSKEYDOWN) and InterceptedSystemKey(wParm) then uMsg := WM_KEYDOWN;
if (uMsg = WM_SYSKEYUP) and InterceptedSystemKey(wParm) then uMsg := WM_KEYUP;
case uMsg of
WM_ACTIVATE:
if not InCloseBackend then
if TWinParam(wParm).LoWord = WA_INACTIVE then
{ When user switches to another program, fake that we release all keys/mouse.
Otherwise we could miss some key up / mouse up, when user releases it over
another program/window.
Do not do this when InCloseBackend, as ReleaseAllKeysAndMouse causes
some DoKeyUp/DoMouseUp (and these even cause BackendMakeCurrent), and no DoXxx
should be done when the window is closing and releasing it's resources. }
ReleaseAllKeysAndMouse;
{ Don't Exit, let control flow to DefWindowProcW. }
WM_ACTIVATEAPP:
begin
Application.appActive := longbool(wParm);
{exit; <- allow DefWindowProcW handle WM_ACTIVETAPP too,
since you can't say "we surely handled everything that should be done in
reaction for this message"}
end;
WM_CLOSE: begin DoCloseQuery; Exit end;
WM_KEYDOWN: begin Handle_WM_KEYDOWN; Exit end;
WM_KEYUP: begin Handle_WM_KEYUP; Exit end;
WM_CHAR: begin Handle_WM_CHAR; Exit end;
WM_IME_STARTCOMPOSITION,
WM_IME_ENDCOMPOSITION,
WM_IME_COMPOSITION:
begin
if Handle_IME then Exit(0);
end;
// WM_UNICHAR answers true, and doesn't call DefWindowProcW, because we handled the message
WM_UNICHAR: begin Handle_WM_UNICHAR; Exit(1); end;
WM_SIZE:
if not InCloseBackend then
begin
{ Note: Window class has (VREDRAW or HREDRAW), so Windows will automatically
take care of requesting window redraw after window resize. }
if (wParm = SIZE_MAXIMIZED) or (wParm = SIZE_RESTORED) then
DoResize(TWinParam(lParm).LoWord, TWinParam(lParm).HiWord, false);
Exit;
end;
WM_MOVE:
{ For some reason, you need to call glViewport at WM_MOVE
(when window moved) on Windows.
Otherwise moving a window, and doing glRedPixels, reads pixels
at *old window placement*. }
begin
fLeft := TWinParam(lParm).LoSmallint;
fTop := TWinParam(lParm).HiSmallint;
{ We need a hack in case of FullScreen and menu.
We want to update Left and Top below to the position
on the screen of our client area. "Client area" means tha place where OpenGL
context is --- it's the window without the border, title bar and menu bar
(if MainMenu <> nil). We need this, because
1. Left and Top are said in unit's interface to work like that
2. SetMousePosition requires this. Otherwise positions
set by SetMousePosition and read by MousePosition properties
would be slightly different.
And there are cases when it is important that they use
exactly the same coordinate systems --- e.g. mouse look handling.
When the window is not FullScreen, WinAPI behaves nice,
and Left and Top as recorded in lParm are exactly what I want.
But when the window is FullScreen, Left and Top
are always 0, 0 --- which means that they don't take menu bar height into
account. The effect: mouse look + menu bar + fullscreen mode don't work.
We workaround this by adding CYMENU. This is not perfect, as this assumes
that menu bar will always be a single line.
(This is also non-perfect anyway, because WM_MOVE message may not get to
FullScreen window at all, so in OpenBackend I also do this trick.) }
if FullScreen and (MainMenu <> nil) and MainMenuVisible then
FTop := FTop + GetSystemMetrics(SM_CYMENU);
{ TODO: Only position actually changed, not size.
Do we really need to call DoResize, OnResize?
Maybe we should just call only glViewport,
using current RenderContext.Viewport? }
DoResize(fRealWidth, fRealHeight, false);
Exit;
end;
WM_SIZING:
begin
result := WMSizingHandler(lParm, wParm, minWidth, minHeight, maxWidth, maxHeight);
Exit;
end;
{ We do not capture WM_PAINT, let WM_PAINT fallback to DefWindowProcW.
WM_PAINT occurs also when there's a need to redraw window frame
(which we don't care about, we don't draw custom window frame).
If there's a need to actually redraw window contents,
then WM_PAINT will cause (immediately, it seems that DefWindowProcW
will just call WndProc) WM_ERASEBKGND, and we want to capture WM_ERASEBKGND. }
WM_ERASEBKGND:
begin
if IsWindowEnabled(H_Wnd) then
Invalidate else
{ If not IsWindowEnabled then we have a modal window blocking our window.
Like a Windows.MessageBox. In this case, our Application.ProcessMessage
may not be continuously called, so we cannot use normal Invalidate
and depend that window will be repainted soon.
IOW, right now we're in WindowProc but not because of calling
DispatchMessage from Application.ProcessMessage. Instead Windows
modal boxes makes artificial call to cause our redraw,
e.g. because user moves the modal window over our window.
So just redraw right now. }
DoRender;
Result := 1;
Exit;
end;
{ This is needed so that our window properly redraws itself when user
activates menu from menu bar. If this is not present then when user
activates our menu bar for the FIRST time (I don't know why only the
first ?) and then opens some drop-drop menu 1, then switches to
another drop-down menu 2, then we have problem: drop-down menu 1 contents
are still partially visible (but only drop-down menu 2 contents should
be visible now !). So our program must come and draw itself, so that
drop-down menu 1 contents are not visible anymore.
Note that this occurs when the user activates our menu bar for the first time.
If he will close the menu and then open it again then Windows will properly
handle everything and drop-down menu 1 contents will not be visible when
drop-down menu 2 is open. (Windows can do this using saved image of our
window, because activating menu under Windows essentially blocks our program
anyway (look at comments at WM_INITMENU)).
I don't know why Windows can't handle this itself when the menu is open
for the first time. So maybe I'm actually fixing a Windows bug by handling
this WM_ENTERIDLE below ? All of this tested on Windows 2000 Prof. }
WM_ENTERIDLE: begin DoRender; Exit end;
WM_INITMENU:
begin
{ We must call ReleaseAllKeysAndMouse when menu is activated.
Even though the application message
loop is blocked while we are in menu (menu under Windows work like modal
windows that block activity of main window, the only way we can do some
action when the menu is open is to handle some messages here like
WM_ENTERIDLE or WM_INITMENU; those messages do NOT come from
castlewindow_winsystem.inc DispatchMessage call, our WndProc is instead
called directly by WinAPI).
Still the problem remains: when someone presses a key (we get DoKeyDown)
and then enters menu and then releases a key (we don't get DoKeyUp) and then
leaves menu -- we have KeysDown[SomeKey] = true where it should be false.
That's why we need this ReleaseAllKeysAndMouse below. }
ReleaseAllKeysAndMouse;
{ Windows blocks our program when user enters a menu bar.
Essentially, this means that window will not receive normal events,
will not process OnUpdate and such during the time menu bar is open.
So menu bar is like a modal dialog box.
So Fps.SecondsPassed at next Update is irrelevant, just like at the end of TGLMode.
Fixes e.g. CameraTransitions when choosing viewpoint from view3dscene menu.
We would like to call this always when user leaves the menu, but it seems
there's no WinAPI event for this. But we can as well call this when user enters
the menu, because of blocking above --- it will have the same effect, since
DoUpdate is not called inside the menu. }
Fps.ZeroNextSecondsPassed;
Exit;
end;
WM_MOUSEMOVE:
begin
{ We could refresh FMousePressed now:
FMousePressed := [];
if (MK_LBUTTON and wParm) <> 0 then Include(FMousePressed, buttonLeft);
if (MK_MBUTTON and wParm) <> 0 then Include(FMousePressed, buttonMiddle);
if (MK_RBUTTON and wParm) <> 0 then Include(FMousePressed, buttonRight);
but it's not needed (we keep it current anyway in mousedown/up events). }
DoMotion(InputMotion(MousePosition, LeftTopToCastle(
TWinParam(lParm).LoSmallint,
TWinParam(lParm).HiSmallint),
MousePressed, 0));
Exit;
end;
WM_LBUTTONDOWN: begin HandleMouseDown(buttonLeft ); Exit end;
WM_MBUTTONDOWN: begin HandleMouseDown(buttonMiddle); Exit end;
WM_RBUTTONDOWN: begin HandleMouseDown(buttonRight ); Exit end;
WM_LBUTTONUP : begin HandleMouseUp(buttonLeft ); Exit end;
WM_MBUTTONUP : begin HandleMouseUp(buttonMiddle); Exit end;
WM_RBUTTONUP : begin HandleMouseUp(buttonRight ); Exit end;
WM_COMMAND :
{ If this comes from a menu item, call DoMenuClick }
if TWinParam(wParm).HiWord = 0 then
begin
DoMenuClick(MenuItemFromSmallId(TWinParam(wParm).LoWord));
Exit;
end;
{ On Windows, we have to change cursor in each WM_SETCURSOR (called on each
mouse move (when mouse not captured), we also manually call it after each
Cursor property change).
That's because Windows internally doesn't have any "cursor" property associated
with h_Wnd --- instead, it has only SetCursor that changes cursor globally,
for everyone. Changing cursor on each WM_SETCURSOR seems to be the solution to
enable / disable our private Cursor value when appropriate, so as not to change
cursor look for other programs. This is also what glut for win32 does, so thanks
go to glut win32 author, Nate Robins, for showing how it's done.
There's some uncertainty whether doing SetCursor calls so often (each WM_SETCURSOR,
each mouse move !) will not decrease performance --- but, well, there seems to be
no other way, and SetCursor docs guarantee that SetCursor checks whether cursor
changes. If no change, SetCursor returns immediately. So, we feel a little safer
that we use CursorHandles[Cursor].Handle, so when Cursor stays the same, SetCursor
is called with exactly the same arguments. }
WM_SETCURSOR:
begin
if (WParm = h_Wnd) and
( (InternalCursor in [mcNone, mcForceNone]) or
(Application.CursorHandles[InternalCursor].Handle <> 0) ) then
begin
Windows.SetCursor(Application.CursorHandles[InternalCursor].Handle);
Exit(1);
end;
{ Otherwise we fall back on DefWindowProcW.
It will install our window class cursor (or parent cursor)
if in client area, or just do the right thing if outside client area.
So it's suitable when wParm <> h_Wnd,
or we want mcDefault. }
end;
WM_MOUSEWHEEL, WM_MOUSEHWHEEL:
begin
if TWinParam(WParm).HiSmallInt <> 0 then
DoMouseWheel(TWinParam(WParm).HiSmallInt / 120, uMsg = WM_MOUSEWHEEL);
Exit;
end;
{ Event received when something in Windows configuration had been changed,
most often this means connecting/disconnecting plug-n-play devices.
Here we use it to detect DBT_DEVICEARRIVAL and DBT_DEVICEREMOVECOMPLETE events
which correspond to adding or removing devices and suggest those are
caused by connecting/disconnecting a Joystick from the system. }
WM_DEVICECHANGE:
begin
case WParm of
{ A device has been sucessfully added to the system }
DBT_DEVICEARRIVAL:
begin
WriteLnLog('Received a WM_DEVICECHANGE event with DBT_DEVICEARRIVAL');
//it might be a joystick, therefore
Joysticks.InternalConnected;
end;
{ A device has been successfully removed from the system.
Currently we more reliably handle this case in Joystick backend Poll
because DBT_DEVICEREMOVECOMPLETE is sent by many different devices
e.g. such as USB flash drive and it isn't right to treat all of these
as disconnected joysticks. E.g. according to Steam recommendations
the game should be set to pause when the joystick is disconnected,
but forcing pause mode every time some arbitrary device has disconnected
may be inconsistent and look like a bug to the user.
The backend does this job better:
1. The InternalDisconnected is sent immediately after the joystick has
been disconnected, while WinAPI message comes with a delay ~0.5 seconds.
2. Backend Poll guarantees that disconnect event comes from a previously
connected joystick, not from any device.
3. Backend Poll guarantees to send the InternalDisconnected event when
joystick stopped working properly, while WinAPI behavior may depend
on joystick driver implementation. }
{DBT_DEVICEREMOVECOMPLETE:
begin
WriteLnLog('Received a WM_DEVICECHANGE event with DBT_DEVICEREMOVECOMPLETE');
//it might be a joystick, therefore
Joysticks.InternalDisconnected;
end;}
{ Something unspecified has changed in the system devices configuration
We don't need to handle this case because we are subscribed to more specific
joystick connect/disconnect events through RegisterDeviceNotification. }
//DBT_DEVNODES_CHANGED: WriteLnLog('Received a WM_DEVICECHANGE event with DBT_DEVNODES_CHANGED');
end;
Exit(1);
end;
end;