-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathDrivers._vp
1183 lines (1098 loc) · 33.9 KB
/
Drivers._vp
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
{/////////////////////////////////////////////////////////////////////////
//
// Dos Navigator Open Source 1.51.08
// Based on Dos Navigator (C) 1991-99 RIT Research Labs
//
// This programs is free for commercial and non-commercial use as long as
// the following conditions are aheared to.
//
// Copyright remains RIT Research Labs, and as such any Copyright notices
// in the code are not to be removed. If this package is used in a
// product, RIT Research Labs should be given attribution as the RIT Research
// Labs of the parts of the library used. This can be in the form of a textual
// message at program startup or in documentation (online or textual)
// provided with the package.
//
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions are
// met:
//
// 1. Redistributions of source code must retain the copyright
// notice, this list of conditions and the following disclaimer.
// 2. Redistributions in binary form must reproduce the above copyright
// notice, this list of conditions and the following disclaimer in the
// documentation and/or other materials provided with the distribution.
// 3. All advertising materials mentioning features or use of this software
// must display the following acknowledgement:
// "Based on Dos Navigator by RIT Research Labs."
//
// THIS SOFTWARE IS PROVIDED BY RIT RESEARCH LABS "AS IS" AND ANY EXPRESS
// OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
// DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR
// ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
// GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
// IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
// OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
// ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
//
// The licence and distribution terms for any publically available
// version or derivative of this code cannot be changed. i.e. this code
// cannot simply be copied and put under another distribution licence
// (including the GNU Public Licence).
//
//////////////////////////////////////////////////////////////////////////}
{AK155 = Alexey Korop, 2:461/155@fidonet}
{$IFDEF DNPRG}
procedure EndFatalError;
var
C, AC: SmallWord;
B: array[0..44] of SmallWord;
SysBuf: PByteArray;
I: Byte;
t: Text;
{Cat: § ª®¬¬¥â¨à®¢ «, ®¡êïᥨï á¬. ¨¦¥}
(*
function GetCoord(X, Y: LongInt): SmallWord;
begin
GetCoord := ((ScreenHeight-8) div 2+Y)*(ScreenWidth*2)+
((ScreenWidth-42) div 2+X)*2;
end;
procedure NewLine;
var CO : SmallWord ;
begin
MoveChar(B, ' ', Byte(C), 44 );
if I in [0,9] then
MoveChar(B, #205, Byte(C), 44)
else
begin
MoveChar(B, #186, Byte(C), 1);
MoveChar(B[43], #186, Byte(C), 1);
end;
if I = 0 then
begin
MoveChar(B, #201, Byte(C), 1);
MoveChar(B[43], #187, Byte(C), 1);
end;
CO := C;
if I = 9 then
begin
MoveChar(B, #200, Byte(C), 1);
MoveChar(B[43], #188, Byte(C), 1);
end;
if I = 8 then CO := AC;
if FreeStr<>'' then
MoveStr(B[ ( 44 - Length(FreeStr)) div 2], FreeStr , Byte(CO));
CO := GetCoord(0,I);
Move(B, SysBuf^[CO], 88);
if I > 0 then
begin
SysBuf^[GetCoord(44,I)+1] := 8;
SysBuf^[GetCoord(45,I)+1] := 8;
end;
SysTVShowBuf(CO, CO+ScreenWidth*2);
end;
*)
begin { EndFatalError }
SysTVClrScr;
SysTvShowBuf(0, ScreenWidth*ScreenHeight);
SysBuf := SysTVGetSrcBuf;
{ Create Report File }
DoDump;
{Cat: § ª®¬¬¥â¨à®¢ « íâã ¯à®æ¥¤ãàã à¨á®¢ ¨ï ªà ᨢ®£® ®ª®èª , â.ª. ¥á«¨
¢ë室¨¬ ç¥à¥§ Exception, â® ¢ ¥ª®â®àëå á«ãç ïå ®® ¥ à¨áã¥âáï
(à¨áã¥âáï ¨«¨ ¥â - § ¢¨á¨â ®â ¬¥á⮯®«®¦¥¨ï ¨áª«î票ï), ¥á«¨
¢ë室¨¬ ç¥à¥§ ExitProc, â® ®® ¥ à¨áã¥âáï ¨ª®£¤ . ‚¥à®ïâ®, íâ®
¯à®¨á室¨â ¨§-§ ¥¨¨æ¨ «¨§¨à®¢ ®á⨠Turbo Vision- . ®áª®«ìªã
¢ë¢®¤ á®®¡é¥¨ï ®¡ ®è¨¡ª¥ - íâ® ¢¥áì¬ áâà ®¥ ¬¥áâ® ¤«ï ¢¥¤¥¨ï
ªà ᨢ®áâ¨, ¬®© ¢§£«ï¤, ᮩ¤ñâ ¨ ¢ë¢®¤ ç¥à¥§ ®¡ëçë© Writeln}
(*
{ Display Error Box }
if Lo(ScreenMode) = smMono then
begin C := SysMonoAttr; AC := $0F07 end else
begin C := SysColorAttr; AC := SysColorButtonAttr end;
for I:=0 to 9 do
begin
case I of
0 : FreeStr := ' Fatal Error ';
2 : FreeStr := 'Exception 0' + Hex2(ExitCode)
+ 'h at address '+Hex8(LongInt(ErrorAddr));
{$IFDEF OS2}
4 : FreeStr := 'Report to 2:5030/1082.53 or to 2:461/155';
5 : FreeStr := 'or to RU.SHELL.DN';
{$ELSE}
4 : FreeStr := 'Report to RU.SHELL.DN';
{$ENDIF}
7 : FreeStr := '( file DN.ERR )';
else FreeStr := '';
end;
NewLine;
end;
*)
Writeln('Fatal Error'^M^J'ÄÄÄÄÄÄÄÄÄÄÄ'^M^J^M^J+
'Exception 0', Hex2(ExitCode), 'h at address ',
Hex8(LongInt(ErrorAddr)), ^M^J+
'Report to RU.SHELL.DN'^M^J+
'( file DN.ERR )'^M^J^M^J+
'Press any key...');
{/Cat}
{Cat: ®è¨¡ª - íâ®, ª®¥ç®, áâà è®, ® ¥ á⮫쪮, çâ®¡ë § £à㦠âì
á¨á⥬ã 100% ¨ àãè âì ®à¬ «ìãî à ¡®âã ¤àã£¨å ¯à®£à ¬¬}
ErrorAddr := nil;
repeat
TinySlice;
until SysKeyPressed;
while SysKeyPressed do
SysReadKey;
SysTVInitCursor;
{/Cat}
end { EndFatalError };
{$ENDIF}
// Detects mouse driver, moves mouse pointer to the top left corner
procedure DetectMouse;
begin
ButtonCount := SysTVDetectMouse;
end;
// Shows mouse pointer
procedure ShowMouse;
begin
SysTVShowMouse;
end;
// Hides mouse pointer
procedure HideMouse;
begin
SysTVHideMouse;
end;
// Initializes Turbo Vision's event manager by setting event mask and
// showing the mouse. Called automatically by TApplication.Init.
procedure InitEvents;
begin
if ButtonCount <> 0 then
begin
DownButtons := 0;
LastDouble := False;
LastButtons := 0; // Assume that no button is pressed
SysTVInitMouse(MouseWhere.X, MouseWhere.Y);
MouseEvents := True;
end;
end;
// Terminates Turbo Vision's event manager and hides the mouse. Called
// automatically by TApplication.Done.
procedure DoneEvents;
begin
if ButtonCount <> 0 then
begin
SysTVDoneMouse(False);
MouseEvents := False;
end;
end;
// Checks whether a mouse event is available by polling the mouse event
// queue maintained by OS/2. If a mouse event has occurred, Event.What
// is set to evMouseDown, evMouseUp,evMouseMove, or evMouseAuto;
// Event.Buttons is set to mbLeftButton or mbRightButton;
// Event.Double is set to True or False;
// Event.Where is set to the mouse position in global coordinates.
// If no mouse events are available, Event.What is set to evNothing.
// GetMouseEvent is called by TProgram.GetEvent.
procedure GetMouseEvent(var Event: TEvent);
var
SysMouseEvent: TSysMouseEvent;
CurTicks: Word;
B: Byte;
procedure StoreEvent(MouWhat: Word);
begin
LastButtons := MouseButtons;
MouseWhere.X := SysMouseEvent.smePos.X;
MouseWhere.Y := SysMouseEvent.smePos.Y;
with Event do
begin
What := MouWhat;
Buttons := MouseButtons;
Double := LastDouble;
Where.X := SysMouseEvent.smePos.X;
Where.Y := SysMouseEvent.smePos.Y;
end;
end;
// GetMouseEvent body
begin { GetMouseEvent }
WheelEvent := False;
if not MouseEvents then
Event.What := evNothing
else
begin
if not SysTVGetMouseEvent(SysMouseEvent) then
begin
MouseButtons := LastButtons;
SysMouseEvent.smeTime := SysSysMsCount;
SysMouseEvent.smePos.X := MouseWhere.X;
SysMouseEvent.smePos.Y := MouseWhere.Y;
end
else
begin
if MouseReverse then
begin
B := 0;
if (SysMouseEvent.smeButtons and $0001) <> 0 then
Inc(B, $0002);
if (SysMouseEvent.smeButtons and $0002) <> 0 then
Inc(B, $0001);
SysMouseEvent.smeButtons := B;
end;
MouseButtons := SysMouseEvent.smeButtons;
end;
// ms -> ticks: 1 DOS timer tick = 55ms
CurTicks := SysMouseEvent.smeTime div 55;
// Process mouse event
if (LastButtons <> 0) and (MouseButtons = 0) then
StoreEvent(evMouseUp) // button is released
else if LastButtons = MouseButtons then
begin
if (SysMouseEvent.smePos.Y <> MouseWhere.Y)
or (SysMouseEvent.smePos.X <> MouseWhere.X)
then
StoreEvent(evMouseMove)
else if (MouseButtons <> 0)
and ((CurTicks-AutoTicks) >= AutoDelay)
then
begin
AutoTicks := CurTicks;
AutoDelay := 1;
StoreEvent(evMouseAuto);
end
else
StoreEvent(evNothing);
end
else // CurButton <> 0, LastButton = 0
begin
LastDouble := False;
if (MouseButtons = DownButtons)
and (SysMouseEvent.smePos.Y = DownWhere.Y)
and (SysMouseEvent.smePos.X = DownWhere.X)
and ((CurTicks-DownTicks) < DoubleDelay)
then
LastDouble := True;
DownButtons := MouseButtons;
DownWhere.Y := SysMouseEvent.smePos.Y;
DownWhere.X := SysMouseEvent.smePos.X;
DownTicks := CurTicks;
AutoTicks := CurTicks;
AutoDelay := RepeatDelay;
StoreEvent(evMouseDown);
end;
end;
end { GetMouseEvent };
procedure InitKeyboard;
begin
SysTVKbdInit;
end;
procedure UpdateMouseWhere;
begin
SysTVUpdateMouseWhere(MouseWhere.X, MouseWhere.Y);
end;
// Checks whether a keyboard event is available. If a key has been
// pressed, Event.What is set to evKeyDown and Event.KeyCode is set to
// the scan code of the key. Otherwise, Event.What is set to evNothing.
// GetKeyEvent is called by TProgram.GetEvent.
const
Letters = [$10..$19, $1E..$26, $2C..$32]; // ‘ª ª®¤ë £«¨©áª¨å ¡ãª¢
{$IFDEF DPMI32}
var
CtrlDigit: Word;
{ ¯®«ë© KeyCode ª« ¢¨è¨ ¢¥à奣® àï¤ á Ctrl }
ScanCode, PrevScancode: Byte;
{$ENDIF}
procedure GetKeyEvent(var Event: TEvent);
var
I: Integer;
SysKeyEvent: TSysKeyEvent;
{Cat}
{/Cat}
{AK155 ®áª®«ìªã ¯®¤ OS/2 ï ¥ ã¬¥î «®¢¨âì ᮡë⨥ ®â¯ã᪠¨ï
ª« ¢¨è¨, â® ¯à®å®¤¨âáï à ᯮ§ ¢ âì íâ® ç¥à¥§ ª®âà®«ì ¢à¥¬¥¨
®âáãâáâ¢¨ï ¦ ⮩ ª« ¢¨è¨. ®-å®à®è¥¬ã, ¤® ¡ë«® ¡ë ª®â஫¨à®¢ âì,
çâ® ¢à¥¬ï ¯à¥¢ëè ¥â ¢à¥¬ï ¢â®¯®¢â®à ª« ¢¨ âãàë, ® ï ¯®-¯à®á⮬ã
ᤥ« « ª®âà®«ì ¯à¥¢ë襨¥ 500 ¬á. 㦮 íâ® ¤«ï £¥¥à 樨
'ª« ¢¨è¨' kbBackUp (®â¯ã᪠¨¥ BackSpace), ª®â®à ï ¯¥à¥ª«îç ¥â
®¡à ¡®âªã kbBack á । ªâ¨à®¢ ¨ï ª®¬áâப¨ ¢ë室 ¨§ ª â «®£ }
const
PrevKeyTime: LongInt = 0;
PrevKey: SmallWord = 0;
{/AK155}
label
WriteKey; {AK155}
begin { GetKeyEvent }
with Event do
{$IFDEF DPMI32}
if wheel_counter <> 0 then
begin
WheelEvent := True;
What := evKeyDown;
if wheel_counter > 0 then
begin
KeyCode := kbDown;
Dec(wheel_counter);
end
else
begin
KeyCode := kbUp;
Inc(wheel_counter);
end;
end
else if CtrlDigit <> 0 then {<Drivers.001>}
begin
What := evKeyDown;
KeyCode := CtrlDigit;
CtrlDigit := 0;
end
else
{$ENDIF}
if not SysTVGetKeyEvent(SysKeyEvent) then
begin
ShiftState := SysTVGetShiftState;
ShiftState2 := SysTVGetShiftState2; {JO}
{AK155 ®àì¡ á «®¦ë¬ à ᯮ§ ¢ ¨¥¬ ®¤¨®ç®£® Alt ¢ १ã«ìâ â¥
祣®-â® ¢à®¤¥ Shift 䮥 Alt. ˆ «®£¨ç® ¤«ï Ctrl}
if ((ShiftState and kbAltShift) <> 0) and
((ShiftState and kbAnyShift) <> kbAltShift)
then
DoubleAltUnlock := False;
if ((ShiftState and kbCtrlShift) <> 0) and
((ShiftState and kbAnyShift) <> kbCtrlShift)
then
DoubleCtrlUnlock := False;
{/AK155}
{JO}
if ( (ShiftState and kbAltShift) = 0)
and ((OldShiftState and kbAltShift) <> 0)
and DoubleAltUnlock
then
begin
What := evKeyDown;
KeyCode := kbDoubleAlt;
end
else if ((ShiftState and kbCtrlShift) = 0)
and ((OldShiftState and kbCtrlShift) <> 0)
and DoubleCtrlUnlock
then
begin
What := evKeyDown;
KeyCode := kbDoubleCtrl;
end
else {AK155}
if (PrevKey = kbBack) and (GetTimemSec-PrevKeyTime > 500) then
begin
PrevKey := 0;
SysKeyEvent.skeKeyCode := kbBackUp;
SysKeyEvent.skeShiftState := 0;
goto WriteKey;
end {/AK155}
else
begin
What := evNothing;
if ( (ShiftState and kbAltShift) = 0) then
DoubleAltUnlock := True;
if ( (ShiftState and kbCtrlShift) = 0) then
DoubleCtrlUnlock := True;
end;
{/JO}OldShiftState := ShiftState
end
else
begin
WriteKey:
OldShiftState := 0; {JO}
What := evKeyDown;
KeyCode := SysKeyEvent.skeKeyCode or ((SysKeyEvent.skeShiftState
and $0F) shl 16); {Cat}
{AK155}
{$IFNDEF DPMI32}
WheelEvent := (SysKeyEvent.skeShiftState and $80) <> 0;
{ á¬. vpsysos2.pas ¨ vpkbdw32.pas}
ShiftState := SysKeyEvent.skeShiftState and $7F;
{$ENDIF}
{/AK155}
{Cat}
if (KeyCode and $030000) <> 0 then
KeyCode := KeyCode or $030000;
{/Cat}
if ( (ShiftState and kbAltShift) <> 0) then
DoubleAltUnlock := False; {JO}
if ( (ShiftState and kbCtrlShift) <> 0) then
begin { Š®¬¡¨ æ¨ï ¢ª«îç ¥â Ctrl.
—â® ¯à¨ í⮬ ⢮à¨âáï á ª®¤®¬ ᨬ¢®« (¬« ¤è¨© ¡ ©â) -
íâ® ª ª®©-â® ¡à¥¤. —â® ¯®¤ OS/2 ¨ ¯®¤ Win ®® à ¡®â ¥â
¯®-à §®¬ã, íâ® ¥ 㤨¢¨â¥«ì®. ® ¤ ¦¥ ¢ à §ëå ¢¥àá¨ïå
Win CharCode ¡ë¢ ¥â à §ë¬. Š ⮬㠦¥ íâ®â ª®¤, ¯®å®¦¥,
¬®¦¥â § ¢¨á¥âì ®â à ᪫ ¤ª¨ ª« ¢¨ âãàë, çâ® ¬ ᮢ¥à襮
¥ 㦮. ®í⮬ã å®ç¥âáï ¯à®áâ® ®¡ã«¨âì ª®¤ ᨬ¢®« , çâ®¡ë ¥
¬¥è «, ¨ à ¡®â âì ⮫쪮 á ᪠ª®¤®¬. ‘®®â¢¥âá⢥®, ¢ Commands
¢® ¢á¥å ª®¤ å kb*Ctrl* ¬« ¤è¨© ¡ ©â ®¡ã«¨âì. ® â ª £«®¡ «ì®
íâ® ¤¥« âì ¥«ì§ï, â ª ª ª ª®¬ ¤ë । ªâ®à , ®¯à¥¤¥¤ñë¥
¢ dn.dnr ç¥à¥§ COMMAND, à ᯮ§ îâáï ç¥à¥§ CharCode, ¥
ç¥à¥§ KeyCode. ®í⮬㠤«ï Ctrl á ¡ãª¢ ¬¨ ¬« ¤è¨© ¡ ©â ¥
âண ¥¬. ‘ ¨¬¨, ª áç áâìî, ¯®¤ ¢á¥¬¨ Ž‘ ¢áñ ®¤¨ ª®¢®.
AK155 25/11/05 }
DoubleCtrlUnlock := False; {JO}
if not (Hi(LongRec(KeyCode).Lo) in Letters) then
KeyCode := KeyCode and $FFFFFF00;
end;
if ((CharCode = #$E0 {Gray Keys})
{AK155 1.03.2005}
{$IFDEF OS2}
or (ShiftState and $03 <> 0)
{ ®¤ OS/2 Shift ª ª ¡ë ¨¢¥àâ¨àã¥â NumLock: ¡¥§ è¨äâ
¯à¨ NumLock ¥ã«¥¢®© CharCode, ¡¥§ NumLock - ã«¥¢®©,
¯à¨ ¦ ⮬ Shift - ®¡®à®â. ‘®®â¢¥âá⢥®, NumLock+Shift
¯à¨¢®¤ïâ ª ¢¢®¤ã æ¨äà. ‚®§¬®¦®, íâ® «®£¨ç¨® ¨ ª®è¥à®, ®
®ç¥ì 㦠¥ã¤®¡®. ˆ, ¯à¨¬¥à, । ªâ®à e ¨«¨ FC/2 â ª ¥ ¤¥« îâ:
®¨ ¯® Shift ¡¥§ NumLoc ¤¥« ¥â ¢ë¤¥«¥¨¥, ¥ ¢¢®¤ïâ æ¨äàë.
㤥¬ ¨ ¬ë â ª ¤¥« âì.
—â® ª á ¥âáï ¢«¨ï¨ï Shift ¯à¨ ¢ª«îçñ®¬ NumLock, â® ¯®¤ ¢¨¤®©
Shift èâ â® ¯à¨¢®¤¨â ª ªãàá®àë¬ ¤¥©áâ¢¨ï¬ (¡¥§ ¢ë¤¥«¥¨ï), ¯®¤
OS/2 - ª ¢ë¤¥«¥¨î. ˆ íâ® à ¡®â ¥â ¨¬¥® â ª ¢® ¢á¥å ¯à®£à ¬¬ å,
¯®í⮬ã íâ® ®áâ ¢«ï¥¬, ª ª ¥áâì, â® ¥áâì ¯®-à §®¬ã ¯®¤ Win ¨ OS/2.}
{$ENDIF OS2}
{/AK155}
)
and
(ScanCode in
[Hi(kbLeft), Hi(kbRight), Hi(kbUp), Hi(kbDown),
Hi(kbIns), Hi(kbDel), Hi(kbHome), Hi(kbEnd), Hi(kbPgUp),
Hi(kbPgDn),
Hi(kbCtrlLeft), Hi(kbCtrlRight), Hi(kbCtrlUp), Hi(kbCtrlDown),
Hi(kbCtrlIns), Hi(kbCtrlDel), Hi(kbCtrlHome), Hi(kbCtrlEnd),
Hi(kbCtrlPgUp), Hi(kbCtrlPgDn)])
then
CharCode := #0;
if KeyCode = $E00D then
// Gray Enter
KeyCode := kbEnter;
{$IFDEF Win32}
if KeyCode = $b2a00 then
// LAlt+LShift under Win32
begin
What := evNothing;
KeyCode := 0;
end;
(* AK155 23/11/05 ’¥¯¥àì íâ® ¥ 㦮, â ª ª ª ¬« ¤è¨© ¡ ©â ®¡ã«ï¥âáï
if KeyCode = $41b1b then
// Ctrl-] ¢ ¢¨¤ å á àãá᪮© à ᪫ ¤ª®©
KeyCode := kbCtrlSqBracketR; // ¯® ¤¥ä®«âã
if KeyCode = $71b1b then
// Shift-Ctrl-] ¢ ¢¨¤ å á àãá᪮©
KeyCode := kbCtrlShiftSqBracketR; // à ᪫ ¤ª®© ¯® ¤¥ä®«âã
*)
{$ENDIF}
(* AK155 23/11/05 ’¥¯¥àì íâ® ¥ 㦮, â ª ª ª ¬« ¤è¨© ¡ ©â ®¡ã«ï¥âáï
{$IFDEF OS2}
// ¨¦¥ ¨¤ãâ ¢®§¬®¦ë¥ ¢ ਠâë ª« ¢¨è Ctrl-[ ¨ Ctrl-] ¯®¤ OS/2
// ¯à¨ èâ ⮩ àãá᪮© à ᪫ ¤ª¥
if KeyCode = $041A85 then
KeyCode := kbCtrlSqBracketL;
if (KeyCode = $041B8A) or (KeyCode = $041B91) then
KeyCode := kbCtrlSqBracketR;
if KeyCode = $071A85 then
KeyCode := kbCtrlShiftSqBracketL;
if (KeyCode = $071B8A) or (KeyCode = $071B91) then
KeyCode := kbCtrlShiftSqBracketR;
{$ENDIF}
*)
PrevKey := KeyCode;
PrevKeyTime := GetTimemSec;
end;
end { GetKeyEvent };
// Returns a byte containing the current Shift key state, as reported by
// the system. The return value contains a combination of the kbXXXX constants
// for shift states.
function GetShiftState: Byte;
var
Handled: Boolean;
begin
Handled := False;
{ if @GetShiftStateHandler <> nil then
Handled := GetShiftStateHandler(Result);
if not Handled then}
Result := SysTVGetShiftState;
end;
{--------------------------------------------------}
// Ctrl-Break handler
function TVCtrlBreak: Boolean; {JO}
{Var Res: Longint;}
begin
{Res := messagebox('Do you wish to terminate DN/2 ?',nil, mfYesButton+mfNoButton);
if Res = cmYes then
begin
CtrlBreakHit := True;
Abort := True;
TVCtrlBreak := False;
end
else
begin}
CtrlBreakHit := True;
{Abort := True;}
TVCtrlBreak := True;
{end;}
end;
{--------------------------------------------------}
// A generalized string formatting routine. Given a string in Format
// that includes format specifiers and a list of parameters in Params,
// FormatStr produces a formatted output string in Result.
// Format specifiers are of the form %[-][nnn]X, where
// % indicates the beginning of a format specifier
// [-] is an optional minus sign (-) indicating the parameter is to be
// left-justified (by default, parameters are right-justified)
// [nnn] is an optional, decimal-number width specifier in the range
// 0..255 (0 indicates no width specified, and non-zero means to
// display in a field of nnn characters)
// X is a format character:
// 's' means the parameter is a pointer to a string.
// 'z' means the parameter is a pointer to an ASCIIZ string (aka PChar).
// 'd' means the parameter is a Longint to be displayed in decimal.
// 'c' means the low byte of the parameter is a character.
// 'x' means the parameter is a Longint to be displayed in hexadecimal.
// 'p' means the parameter is a Pointer to be displayed in hexadecimal.
// '#' sets the parameter index to nnn.
procedure FormatStr(var Result: String; const Format: String; var Params);
//AK155 assembler; {&USES ebx,esi,edi} {&FRAME+}
var
ParOfs: LongInt;
Filler, Justify: Byte;
Buffer: array[1..12] of Byte;
// Convert next parameter to string
// EXPECTS: al = Conversion character
// RETURNS: esi = Pointer to string
// ecx = String length
procedure Convert; {&USES None}
{&FRAME-}
asm
mov edx,eax
mov esi,Params
lodsd
mov Params,esi
xor ecx,ecx
lea esi,Buffer[TYPE Buffer]
and dl,0DFh // UpCase(ConversionChar)
cmp dl,'C'
je @@ConvertChar
cmp dl,'S'
je @@ConvertStr
cmp dl,'D'
je @@ConvertDec
cmp dl,'P' {Cat}
je @@ConvertPointer {Cat}
cmp dl,'Z' {Cat}
je @@ConvertPChar {Cat}
cmp dl,'X'
jne @@Done
// ConvertHex
@@1:
mov edx,eax
and edx,0Fh
mov dl,HexStr.Byte[edx]
dec esi
inc ecx
mov [esi],dl
shr eax,4
jnz @@1
jmp @@Done
{Cat}
@@ConvertPointer:
@@3:
mov edx,eax
and edx,0Fh
mov dl,HexStr.Byte[edx]
dec esi
inc ecx
mov [esi],dl
shr eax,4
cmp ecx,8
jne @@3
jmp @@Done
@@ConvertPChar:
test eax,eax
jz @@Done
push eax
xor ecx,ecx
mov esi,eax
@@4:
inc ecx
lodsb
cmp al,0
jnz @@4
dec ecx
pop esi
jmp @@Done
{/Cat}
@@ConvertDec:
push esi
mov ebx,eax
mov ecx,10
test eax,eax
jns @@2
neg eax
@@2:
xor edx,edx
dec esi
div ecx
add dl,'0'
mov [esi],dl
test eax,eax
jnz @@2
pop ecx
sub ecx,esi
test ebx,ebx
jns @@Done
mov al,'-'
@@ConvertChar:
inc ecx
dec esi
mov [esi],al
jmp @@Done
@@ConvertStr:
test eax,eax
jz @@Done
mov esi,eax
lodsb
mov cl,al
@@Done:
end;
// FormatStr body
begin
{AK155: ¡¥§ «¨§ @Params = nil FormatStr ¯ ¤ ¥â, ¯à¨¬¥à,
¯®¤â¢¥à¦¤¥¨¨ 㤠«¥¨ï ª â «®£ á ¨¬¥¥¬ %F. ‚ ª« áá¨ç¥áª®à¬ DN
í⠯஢¥àª ¡ë« , ¢ DN OSP RC1 Dos - ⮦¥ ¥áâì, âã⠪㤠-â® ¤¥« áì. }
if @Params = nil then
Result := Format
else
asm
push ebx
push esi
push edi
mov eax,Params
mov ParOfs,eax
xor eax,eax
mov esi,Format
mov edi,Result
inc edi
cld
lodsb
mov ecx,eax
mov ebx,255
@@1:
dec ecx
js @@End
lodsb
cmp al,'%'
je @@3
dec ebx
js @@End
@@2:
stosb
jmp @@1
@@3:
dec ecx
js @@End
lodsb
cmp al,'%'
je @@2
mov Justify,0 // Justify (0:right, 1:left)
mov Filler,' '
xor edx,edx // edx = Field width (0:no width)
cmp al,'0'
jne @@4
mov Filler,al
@@4:
cmp al,'-'
jne @@5
inc Justify
dec ecx
js @@End
lodsb
@@5:
cmp al,'0'
jb @@6
cmp al,'9'
ja @@6
sub al,'0'
xchg eax,edx
mov ah,10
mul ah
add al,dl
xchg eax,edx
dec ecx
js @@End
lodsb
jmp @@5
@@6:
cmp al,'#'
jne @@10
shl edx,2
add edx,ParOfs
mov Params,edx
jmp @@1
@@End:
mov eax,Result
mov ecx,edi
sub ecx,eax
dec ecx
mov [eax],cl
jmp @@Done
@@10:
push esi
push ecx
push edx
push ebx
Call Convert
pop ebx
pop edx
test edx,edx
jz @@12
sub edx,ecx
jae @@12
cmp Justify,0
jnz @@11
sub esi,edx
@@11:
add ecx,edx
xor edx,edx
@@12:
cmp Justify,0
jz @@14
cmp ecx,ebx
jbe @@13
mov ecx,ebx
@@13:
sub ebx,ecx
rep movsb // Copy formated parm (left-justified)
@@14:
xchg ecx,edx
mov al,Filler
cmp ecx,ebx
jbe @@15
mov ecx,ebx
@@15:
sub ebx,ecx
rep stosb // Fill unused space
xchg ecx,edx
cmp ecx,ebx
jbe @@16
mov ecx,ebx
@@16:
sub ebx,ecx
rep movsb // Copy formated parm (right-justified)
pop ecx
pop esi
jmp @@1
@@Done:
pop edi
pop esi
pop ebx
end;
end { FormatStr };
// Prints the string on the screen
procedure PrintStr(const S: String);
var
Count: LongInt;
begin
SysFileWrite(SysFileStdOut, S[1], Length(S), Count);
end;
// Buffer move routines
// Moves text and video attributes into a buffer. Count bytes are moved
// from Source into the low bytes of corresponding words in Dest. The
// high bytes of the words in Dest are set to Attr, or remain unchanged
// if Attr is zero.
procedure MoveBuf(var Dest; var Source; Attr: Byte; Count: Word);
{&USES esi,edi} {&FRAME-}
asm
mov ecx,Count
jecxz @@4
mov edi,Dest
mov esi,Source
mov ah,Attr
cld
test ah,ah
jz @@3
@@1:
lodsb
stosw
loop @@1
jmp @@4
@@2:
inc edi
@@3:
movsb
loop @@2
@@4:
end;
procedure MoveColor(var Buf; Num: Word; Attr: Byte);
assembler; {$USES EBX, ECX}
asm
mov EBX,Buf
mov ECX,Num
or ECX,ECX
jz @End
mov AL,Attr
@Rep:
mov [EBX+1],al
add bx,2
loop @Rep
@End:
end;
// Moves characters into a buffer. The low bytes of the first Count
// words of Dest are set to C, or remain unchanged if C = #0. The high
// bytes of the words are set to Attr, or remain unchanged if Attr is
// zero.
procedure MoveChar(var Dest; C: Char; Attr: Byte; Count: Word);
{&USES edi} {&FRAME-}
asm
mov ecx,Count
jecxz @@4
mov edi,Dest
mov al,C
mov ah,Attr
cld
test al,al
jz @@1
test ah,ah
jz @@3
mov edx,eax
shl eax,16
mov ax,dx
shr ecx,1
rep stosd
adc ecx,ecx
rep stosw
jmp @@4
@@1:
mov al,ah
@@2:
inc edi
@@3:
stosb
loop @@2
@@4:
end;
// Moves a two-colored string into a buffer. The characters in Str are
// moved into the low bytes of corresponding words in Dest. The high
// bytes of the words are set to Lo(Attr) or Hi(Attr). Tilde characters
// (~) in the string toggle between the two attribute bytes passed in
// the Attr word.
{AK155: ¤®¡ ¢«¥® ¨á¯®«ì§®¢ ¨¥ ᨬ¢®« #0 ¢ ª ç¥á⢥ ¢â®à¥£¨áâà :
á«¥¤ãî騩 § ¨¬ ᨬ¢®« ®â®¡à ¦ ¥âáï ¡¥§ãá«®¢® (¤ ¦¥ ¥á«¨ íâ® '~').
⮠ᮣ« ᮢ ® á advance.FormatLongName.MakeResult
06.01.2001}
procedure MoveCStr(var Dest; const Str: String; Attrs: Word);
{&USES esi,edi} {&FRAME-}
asm
xor ecx,ecx
mov esi,Str
cld
lodsb
mov cl,al
jecxz @@3
mov edi,Dest
mov edx,Attrs
mov ah,dl
@@1:
lodsb
cmp al,0
jne @@6
loop @@5
jmp @@3
@@5:
lodsb
jmp @@7
@@6:
cmp al,'~'
je @@2
@@7:
stosw
loop @@1
jmp @@3
@@2:
xchg ah,dh
loop @@1
@@3:
end;
// Moves a string into a buffer. The characters in Str are moved into
// the low bytes of corresponding words in Dest. The high bytes of the
// words are set to Attr, or remain unchanged if Attr is zero.
procedure MoveStr(var Dest; const Str: String; Attr: Byte);
{&USES esi,edi} {&FRAME-}
asm
xor ecx,ecx
mov esi,Str
cld
lodsb
mov cl,al
jecxz @@4
mov edi,Dest
mov ah,Attr