diff --git a/fv/app.pas b/fv/app.pas
index 6097c722a6..ac21b8556e 100644
--- a/fv/app.pas
+++ b/fv/app.pas
@@ -22,28 +22,9 @@
{ ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. }
{ }
{*****************[ SUPPORTED PLATFORMS ]******************}
-{ 16 and 32 Bit compilers }
-{ DOS - Turbo Pascal 7.0 + (16 Bit) }
-{ DPMI - Turbo Pascal 7.0 + (16 Bit) }
-{ - FPC 0.9912+ (GO32V2) (32 Bit) }
-{ WINDOWS - Turbo Pascal 7.0 + (16 Bit) }
-{ - Delphi 1.0+ (16 Bit) }
-{ WIN95/NT - Delphi 2.0+ (32 Bit) }
-{ - Virtual Pascal 2.0+ (32 Bit) }
-{ - FPC 0.9912+ (32 Bit) }
-{ OS2 - Virtual Pascal 1.0+ (32 Bit) }
{ }
-{******************[ REVISION HISTORY ]********************}
-{ Version Date Fix }
-{ ------- --------- --------------------------------- }
-{ 1.00 12 Dec 96 First multi platform release }
-{ 1.10 12 Sep 97 FPK pascal 0.92 conversion added. }
-{ 1.20 29 Aug 97 Platform.inc sort added. }
-{ 1.30 05 May 98 Virtual pascal 2.0 code added. }
-{ 1.40 22 Oct 99 Object registration added. }
-{ 1.50 22 Oct 99 Complete recheck preformed }
-{ 1.51 03 Nov 99 FPC Windows support added }
-{ 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }
+{ Only Free Pascal Compiler supported }
+{ }
{**********************************************************}
UNIT App;
@@ -58,17 +39,6 @@ UNIT App;
{==== Compiler directives ===========================================}
-{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
- {$F-} { Near calls are okay }
- {$A+} { Word Align Data }
- {$B-} { Allow short circuit boolean evaluations }
- {$O+} { This unit may be overlaid }
- {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
- {$P-} { Normal string variables }
- {$N-} { No 80x87 code generation }
- {$E+} { Emulation is on }
-{$ENDIF}
-
{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
{$S-} { Disable Stack Checking }
@@ -79,21 +49,7 @@ UNIT App;
USES
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
- {$IFNDEF PPC_SPEED} { NON SPEED COMPILER }
- {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
Windows, { Standard units }
- {$ELSE} { OTHER COMPILERS }
- WinTypes,WinProcs, { Standard units }
- {$ENDIF}
- {$IFNDEF PPC_DELPHI} { NON DELPHI1 COMPILER }
- {$IFDEF BIT_16} Win31, {$ENDIF} { 16 BIT WIN 3.1 UNIT }
- {$ENDIF}
- {$ELSE} { SPEEDSOFT COMPILER }
- WinBase, WinDef, { Standard units }
- {$ENDIF}
- {$IFDEF PPC_DELPHI} { DELPHI COMPILERS }
- Messages, { Standard unit }
- {$ENDIF}
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
@@ -162,8 +118,7 @@ CONST
{ Turbo Vision 2.0 Color Palettes }
CAppColor =
- {$IFDEF OS_WINDOWS}#$81+{$ELSE}#$71+{$ENDIF}
- #$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F +
+ #$71#$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F +
#$37#$3F#$3A#$13#$13#$3E#$21#$3F#$70#$7F#$7A#$13#$13#$70#$7F#$7E +
#$70#$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 +
#$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 +
@@ -356,11 +311,7 @@ PROCEDURE RegisterApp;
CONST
RBackGround: TStreamRec = (
ObjType: 30; { Register id = 30 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TBackGround)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TBackGround);
- {$ENDIF}
Load: @TBackGround.Load; { Object load method }
Store: @TBackGround.Store { Object store method }
);
@@ -371,11 +322,7 @@ CONST
CONST
RDeskTop: TStreamRec = (
ObjType: 31; { Register id = 31 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TDeskTop)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TDeskTop);
- {$ENDIF}
Load: @TDeskTop.Load; { Object load method }
Store: @TDeskTop.Store { Object store method }
);
@@ -398,10 +345,8 @@ CONST
IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
-{$ifdef Use_API}
uses
Video,Mouse;
-{$endif Use_API}
{***************************************************************************}
{ PRIVATE DEFINED CONSTANTS }
@@ -416,80 +361,6 @@ CONST
{---------------------------------------------------------------------------}
CONST Pending: TEvent = (What: evNothing); { Pending event }
-{***************************************************************************}
-{ PRIVATE INTERNAL ROUTINES }
-{***************************************************************************}
-{$IFDEF OS_WINDOWS}
-{---------------------------------------------------------------------------}
-{ AppMsgHandler -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 13May98 LdB }
-{---------------------------------------------------------------------------}
-FUNCTION TvAppMsgHandler (Wnd: hWnd; iMessage, wParam: Sw_Word;
-lParam: LongInt): LongInt; {$IFDEF BIT_16} EXPORT; {$ELSE} STDCALL; {$ENDIF}
-VAR Event: TEvent; P: PView; Mm: ^TMinMaxInfo;
-BEGIN
- {$IFDEF BIT_16} { 16 BIT CODE }
- PtrRec(P).Seg := GetProp(Wnd, ViewSeg); { Fetch seg property }
- PtrRec(P).Ofs := GetProp(Wnd, ViewOfs); { Fetch ofs property }
- {$ENDIF}
- {$IFDEF BIT_32} { 32 BIT CODE }
- LongInt(P) := GetProp(Wnd, ViewPtr); { Fetch view property }
- {$ENDIF}
- TvAppMsgHandler := 0; { Preset zero return }
- Event.What := evNothing; { Preset no event }
- Case iMessage Of
- WM_Destroy:; { Destroy window }
- WM_Close: Begin
- Event.What := evCommand; { Command event }
- Event.Command := cmQuit; { Quit command }
- Event.InfoPtr := Nil; { Clear info ptr }
- End;
- WM_GetMinMaxInfo: Begin { Get minmax info }
- TvAppMsgHandler := DefWindowProc(Wnd,
- iMessage, wParam, lParam); { Default handler }
- Mm := Pointer(lParam); { Create pointer }
- Mm^.ptMaxSize.X := SysScreenWidth; { Max x size }
- Mm^.ptMaxSize.Y := SysScreenHeight; { Max y size }
- Mm^.ptMinTrackSize.X := MinWinSize.X *
- SysFontWidth; { Drag min x size }
- Mm^.ptMinTrackSize.Y := MinWinSize.Y *
- SysFontHeight; { Drag min y size }
- Mm^.ptMaxTrackSize.X := SysScreenWidth; { Drag max x size }
- Mm^.ptMaxTrackSize.Y := SysScreenHeight; { Drag max y size }
- End;
- Else Begin { Unhandled message }
- TvAppMsgHandler := DefWindowProc(Wnd,
- iMessage, wParam, lParam); { Default handler }
- Exit; { Now exit }
- End;
- End;
- If (Event.What <> evNothing) Then { Check any FV event }
- PutEventInQueue(Event); { Put event in queue }
-END;
-{$ENDIF}
-{$IFDEF OS_OS2} { OS2 CODE }
-FUNCTION TvAppMsgHandler(Wnd: HWnd; Msg: ULong; Mp1, Mp2: MParam): MResult; CDECL;
-VAR Event: TEvent; P: PView;
-BEGIN
- Event.What := evNothing; { Preset no event }
- TvAppMsgHandler := 0; { Preset zero return }
- Case Msg Of
- WM_Destroy:; { Destroy window }
- WM_Close: Begin
- Event.What := evCommand; { Command event }
- Event.Command := cmQuit; { Quit command }
- Event.InfoPtr := Nil; { Clear info ptr }
- End;
- Else Begin { Unhandled message }
- TvAppMsgHandler := WinDefWindowProc(Wnd,
- Msg, Mp1, Mp2); { Call std handler }
- Exit; { Now exit }
- End;
- End;
- If (Event.What <> evNothing) Then { Check any FV event }
- PutEventInQueue(Event); { Put event in queue }
-END;
-{$ENDIF}
-
{---------------------------------------------------------------------------}
{ Tileable -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
{---------------------------------------------------------------------------}
@@ -558,11 +429,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
{---------------------------------------------------------------------------}
FUNCTION TBackGround.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CBackGround; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CBackGround)] = CbackGround; { Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@@ -776,7 +643,6 @@ END;
{ TProgram OBJECT METHODS }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-CONST TvProgramClassName = 'TVPROGRAM'+#0; { TV program class }
{--TProgram-----------------------------------------------------------------}
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
@@ -784,11 +650,11 @@ CONST TvProgramClassName = 'TVPROGRAM'+#0; { TV program class }
CONSTRUCTOR TProgram.Init;
VAR I: Integer; R: TRect;
BEGIN
- Application := @Self; { Set application ptr }
- InitScreen; { Initialize screen }
R.Assign(0, 0, -(GetMaxX(TextModeGFV)+1),
-(GetMaxY(TextModeGFV)+1)); { Full screen area }
Inherited Init(R); { Call ancestor }
+ Application := @Self; { Set application ptr }
+ InitScreen; { Initialize screen }
State := sfVisible + sfSelected + sfFocused +
sfModal + sfExposed; { Deafult states }
Options := 0; { No options set }
@@ -810,6 +676,9 @@ END;
DESTRUCTOR TProgram.Done;
VAR I: Integer;
BEGIN
+ { Do not free the Buffer of Video Unit }
+ If Buffer = Views.PVideoBuf(VideoBuf) then
+ Buffer:=nil;
If (Desktop <> Nil) Then Dispose(Desktop, Done); { Destroy desktop }
If (MenuBar <> Nil) Then Dispose(MenuBar, Done); { Destroy menu bar }
If (StatusLine <> Nil) Then
@@ -916,22 +785,6 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE TProgram.InitScreen;
BEGIN
-{$ifndef Use_API}
- If (Lo(ScreenMode) <> smMono) Then Begin { Coloured mode }
- If (ScreenMode AND smFont8x8 <> 0) Then
- ShadowSize.X := 1 Else { Single bit shadow }
- ShadowSize.X := 2; { Double size }
- ShadowSize.Y := 1; ShowMarkers := False; { Set variables }
- If (Lo(ScreenMode) = smBW80) Then
- AppPalette := apBlackWhite Else { B & W palette }
- AppPalette := apColor; { Coloured palette }
- End Else Begin
- ShadowSize.X := 0; { No x shadow size }
- ShadowSize.Y := 0; { No y shadow size }
- ShowMarkers := True; { Show markers }
- AppPalette := apMonochrome; { Mono palette }
- End;
-{$else Use_API}
{ the orginal code can't be used here because of the limited
video unit capabilities, the mono modus can't be handled
}
@@ -947,7 +800,6 @@ BEGIN
else
AppPalette := apBlackWhite;
Buffer := Views.PVideoBuf(VideoBuf);
-{$endif Use_API}
END;
{--TProgram-----------------------------------------------------------------}
@@ -1023,6 +875,10 @@ BEGIN
NextQueuedEvent(Event); { Next queued event }
If (Event.What = evNothing) Then Begin
GetKeyEvent(Event); { Fetch key event }
+{$ifdef DEBUG}
+ If (Event.What = evKeyDown) then
+ Writeln(stderr,'Key pressed scancode = ',hexstr(Event.Keycode,4));
+{$endif}
If (Event.What = evNothing) Then Begin { No mouse event }
Drivers.GetMouseEvent(Event); { Load mouse event }
If (Event.What = evNothing) Then Idle; { Idle if no event }
@@ -1227,7 +1083,10 @@ END;
END.
{
$Log$
- Revision 1.8 2001-05-07 22:22:03 pierre
+ Revision 1.9 2001-05-10 16:46:26 pierre
+ + some improovements made
+
+ Revision 1.8 2001/05/07 22:22:03 pierre
* removed NO_WINDOW cond, added GRAPH_API
Revision 1.7 2001/05/04 15:43:45 pierre
@@ -1247,8 +1106,17 @@ END.
Revision 1.2 2000/08/24 11:43:13 marco
* Added CVS log and ID entries.
-
-
}
+{******************[ REVISION HISTORY ]********************}
+{ Version Date Fix }
+{ ------- --------- --------------------------------- }
+{ 1.00 12 Dec 96 First multi platform release }
+{ 1.10 12 Sep 97 FPK pascal 0.92 conversion added. }
+{ 1.20 29 Aug 97 Platform.inc sort added. }
+{ 1.30 05 May 98 Virtual pascal 2.0 code added. }
+{ 1.40 22 Oct 99 Object registration added. }
+{ 1.50 22 Oct 99 Complete recheck preformed }
+{ 1.51 03 Nov 99 FPC Windows support added }
+{ 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }
diff --git a/fv/dialogs.pas b/fv/dialogs.pas
index 37e815ad80..360dd5a198 100644
--- a/fv/dialogs.pas
+++ b/fv/dialogs.pas
@@ -1,4 +1,4 @@
-{ $Id: }
+{ $Id$ }
{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
{ }
{ System independent GRAPHICAL clone of DIALOGS.PAS }
@@ -21,29 +21,9 @@
{ ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. }
{ }
{*****************[ SUPPORTED PLATFORMS ]******************}
-{ 16 and 32 Bit compilers }
-{ DOS - Turbo Pascal 7.0 + (16 Bit) }
-{ DPMI - Turbo Pascal 7.0 + (16 Bit) }
-{ - FPC 0.9912+ (GO32V2) (32 Bit) }
-{ WINDOWS - Turbo Pascal 7.0 + (16 Bit) }
-{ - Delphi 1.0+ (16 Bit) }
-{ WIN95/NT - Delphi 2.0+ (32 Bit) }
-{ - Virtual Pascal 2.0+ (32 Bit) }
-{ - Speedsoft Sybil 2.0+ (32 Bit) }
-{ - FPC 0.9912+ (32 Bit) }
-{ OS2 - Virtual Pascal 1.0+ (32 Bit) }
{ }
-{******************[ REVISION HISTORY ]********************}
-{ Version Date Fix }
-{ ------- --------- --------------------------------- }
-{ 1.00 11 Nov 96 First DOS/DPMI platform release. }
-{ 1.10 13 Jul 97 Windows platform code added. }
-{ 1.20 29 Aug 97 Platform.inc sort added. }
-{ 1.30 13 Oct 97 Delphi 2 32 bit code added. }
-{ 1.40 05 May 98 Virtual pascal 2.0 code added. }
-{ 1.50 27 Oct 99 All objects completed and checked }
-{ 1.51 03 Nov 99 FPC windows support added }
-{ 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }
+{ Only Free Pascal Compiler supported }
+{ }
{**********************************************************}
UNIT Dialogs;
@@ -58,16 +38,6 @@ UNIT Dialogs;
{==== Compiler directives ===========================================}
-{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
- {$F-} { Short calls are okay }
- {$A+} { Word Align Data }
- {$B-} { Allow short circuit boolean evaluations }
- {$O+} { This unit may be overlaid }
- {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
- {$P-} { Normal string variables }
- {$N-} { No 80x87 code generation }
- {$E+} { Emulation is on }
-{$ENDIF}
{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
@@ -79,18 +49,7 @@ UNIT Dialogs;
USES
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
- {$IFNDEF PPC_SPEED} { NON SPEED COMPILER }
- {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
Windows, { Standard units }
- {$ELSE} { OTHER COMPILERS }
- WinTypes,WinProcs, { Standard units }
- {$ENDIF}
- {$ELSE} { SPEEDSOFT COMPILER }
- WinBase, WinDef, WinUser, WinGDI, { Standard units }
- {$ENDIF}
- {$IFDEF PPC_DELPHI} { DELPHI COMPILERS }
- Messages, { Standard unit }
- {$ENDIF}
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
@@ -127,14 +86,6 @@ CONST
CDialog = CGrayDialog; { Default palette }
-{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
-{---------------------------------------------------------------------------}
-{ NEW WIN/NT/OS2 COMMAND CODES }
-{---------------------------------------------------------------------------}
-CONST
- cmTvClusterButton = $2001; { Cluster button cmd id }
-{$ENDIF}
-
{---------------------------------------------------------------------------}
{ TDialog PALETTE COLOUR CONSTANTS }
{---------------------------------------------------------------------------}
@@ -492,11 +443,7 @@ PROCEDURE RegisterDialogs;
CONST
RDialog: TStreamRec = (
ObjType: 10; { Register id = 10 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TDialog)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TDialog);
- {$ENDIF}
Load: @TDialog.Load; { Object load method }
Store: @TDialog.Store { Object store method }
);
@@ -507,11 +454,7 @@ CONST
CONST
RInputLine: TStreamRec = (
ObjType: 11; { Register id = 11 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TInputLine)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TInputLine);
- {$ENDIF}
Load: @TInputLine.Load; { Object load method }
Store: @TInputLine.Store { Object store method }
);
@@ -522,11 +465,7 @@ CONST
CONST
RButton: TStreamRec = (
ObjType: 12; { Register id = 12 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TButton)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TButton);
- {$ENDIF}
Load: @TButton.Load; { Object load method }
Store: @TButton.Store { Object store method }
);
@@ -537,11 +476,7 @@ CONST
CONST
RCluster: TStreamRec = (
ObjType: 13; { Register id = 13 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TCluster)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TCluster);
- {$ENDIF}
Load: @TCluster.Load; { Object load method }
Store: @TCluster.Store { Objects store method }
);
@@ -552,11 +487,7 @@ CONST
CONST
RRadioButtons: TStreamRec = (
ObjType: 14; { Register id = 14 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TRadioButtons)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TRadioButtons);
- {$ENDIF}
Load: @TRadioButtons.Load; { Object load method }
Store: @TRadioButtons.Store { Object store method }
);
@@ -567,11 +498,7 @@ CONST
CONST
RCheckBoxes: TStreamRec = (
ObjType: 15; { Register id = 15 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TCheckBoxes)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TCheckBoxes);
- {$ENDIF}
Load: @TCheckBoxes.Load; { Object load method }
Store: @TCheckBoxes.Store { Object store method }
);
@@ -582,11 +509,7 @@ CONST
CONST
RMultiCheckBoxes: TStreamRec = (
ObjType: 27; { Register id = 27 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TMultiCheckBoxes)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TMultiCheckBoxes);
- {$ENDIF}
Load: @TMultiCheckBoxes.Load; { Object load method }
Store: @TMultiCheckBoxes.Store { Object store method }
);
@@ -597,11 +520,7 @@ CONST
CONST
RListBox: TStreamRec = (
ObjType: 16; { Register id = 16 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TListBox)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TListBox);
- {$ENDIF}
Load: @TListBox.Load; { Object load method }
Store: @TListBox.Store { Object store method }
);
@@ -612,11 +531,7 @@ CONST
CONST
RStaticText: TStreamRec = (
ObjType: 17; { Register id = 17 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TStaticText)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TStaticText);
- {$ENDIF}
Load: @TStaticText.Load; { Object load method }
Store: @TStaticText.Store { Object store method }
);
@@ -627,11 +542,7 @@ CONST
CONST
RLabel: TStreamRec = (
ObjType: 18; { Register id = 18 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TLabel)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TLabel);
- {$ENDIF}
Load: @TLabel.Load; { Object load method }
Store: @TLabel.Store { Object store method }
);
@@ -642,11 +553,7 @@ CONST
CONST
RHistory: TStreamRec = (
ObjType: 19; { Register id = 19 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(THistory)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(THistory);
- {$ENDIF}
Load: @THistory.Load; { Object load method }
Store: @THistory.Store { Object store method }
);
@@ -657,11 +564,7 @@ CONST
CONST
RParamText: TStreamRec = (
ObjType: 20; { Register id = 20 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TParamText)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TParamText);
- {$ENDIF}
Load: @TParamText.Load; { Object load method }
Store: @TParamText.Store { Object store method }
);
@@ -679,10 +582,7 @@ USES HistList; { Standard GFV unit }
{---------------------------------------------------------------------------}
{ LEFT AND RIGHT ARROW CHARACTER CONSTANTS }
{---------------------------------------------------------------------------}
-{$IFDEF OS_DOS} CONST LeftArr = #17; RightArr = #16; {$ENDIF}
-{$IFDEF OS_LINUX} CONST LeftArr = #17; RightArr = #16; {$ENDIF}
-{$IFDEF OS_WINDOWS} CONST LeftArr = #$AB; RightArr = #$BB; {$ENDIF}
-{$IFDEF OS_OS2} CONST LeftArr = #17; RightArr = #16; {$ENDIF}
+CONST LeftArr = #17; RightArr = #16;
{---------------------------------------------------------------------------}
{ TButton MESSAGES }
@@ -730,10 +630,6 @@ BEGIN
GrowMode := 0; { Clear grow mode }
Flags := wfMove + wfClose; { Close/moveable flags }
Palette := dpGrayDialog; { Default gray colours }
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- GOptions := GOptions AND NOT goThickFramed; { Turn thick frame off }
- ExStyle := ws_Ex_DlgModalFrame; { Set extended style }
- {$ENDIF}
END;
{--TDialog------------------------------------------------------------------}
@@ -752,13 +648,8 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TDialog.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: Array[dpBlueDialog..dpGrayDialog] Of String =
- (CBlueDialog, CCyanDialog, CGrayDialog); { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: Array[dpBlueDialog..dpGrayDialog] Of String[Length(CBlueDialog)] =
(CBlueDialog, CCyanDialog, CGrayDialog); { Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P[Palette]; { Return palette }
END;
@@ -844,11 +735,7 @@ BEGIN
If (MaxAvail > MaxLen+1) Then Begin { Check enough memory }
GetMem(Data, MaxLen + 1); { Allocate memory }
S.Read(Data^[1], Length(Data^)); { Read string data }
- {$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
SetLength(Data^, B); { Xfer string length }
- {$ELSE} { OTHER COMPILERS }
- Data^[0] := Chr(B); { Set string length }
- {$ENDIF}
End Else S.Seek(S.GetPos + B); { Move to position }
If (Options AND ofVersion >= ofVersion20) Then { Version 2 or above }
Validator := PValidator(S.Get); { Get any validator }
@@ -883,11 +770,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TInputLine.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CInputLine; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CInputLine)] = CInputLine; { Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@@ -1048,18 +931,11 @@ END;
{ SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TInputLine.SetData (Var Rec);
-{$IFDEF PPC_DELPHI3} VAR Buf: Array [0..256] Of Char; {$ENDIF}
BEGIN
If (Data <> Nil) Then Begin { Data ptr valid }
If (Validator = Nil) OR (Validator^.Transfer(
Data^, @Rec, vtSetData) = 0) Then { No validator/data }
- {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
- Move(Rec, Buf, DataSize); { Fetch our data }
- Move(Buf[1], Data^[1], Ord(Buf[0])); { Tranfer string }
- SetLength(Data^, Ord(Buf[0])); { Set string length }
- {$ELSE} { OTHER COMPILERS }
Move(Rec, Data^[0], DataSize); { Set our data }
- {$ENDIF}
End;
SelectAll(True); { Now select all }
END;
@@ -1169,11 +1045,7 @@ Delta, Anchor, OldCurPos, OldFirstPos, OldSelStart, OldSelEnd: Integer;
If NOT Validator^.IsValidInput(NewData,
NoAutoFill) Then RestoreState Else Begin
If (Length(NewData) > MaxLen) Then { Exceeds maximum }
- {$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
SetLength(NewData, MaxLen); { Set string length }
- {$ELSE} { OTHER COMPILERS }
- NewData[0] := Chr(MaxLen); { Set string length }
- {$ENDIF}
If (Data <> Nil) Then Data^ := NewData; { Set data value }
If (Data <> Nil) AND (CurPos >= OldLen) { Cursor beyond end }
AND (Length(Data^) > OldLen) Then { Cursor beyond string }
@@ -1210,11 +1082,7 @@ BEGIN
SelectAll(True) Else Begin { Select whole text }
Anchor := MousePos; { Start of selection }
Repeat
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
If (Event.What = evMouseAuto) { Mouse auto event }
- {$ELSE} { WIN/NT/OS2 CODE }
- If (Event.What = evMouseMove) { Mouse move event }
- {$ENDIF}
Then Begin
Delta := MouseDelta; { New position }
If CanScroll(Delta) Then { If can scroll }
@@ -1304,11 +1172,7 @@ BEGIN
If (Data <> Nil) Then OldData := Copy(Data^,
FirstPos+1, CurPos-FirstPos) { Text area string }
Else OldData := ''; { Empty string }
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
Delta := FontWidth; { Safety = 1 char }
- {$ELSE} { WIN/NT CODE }
- Delta := 2*FontWidth; { Safety = 2 char }
- {$ENDIF}
While (TextWidth(OldData) > ((RawSize.X+1)-Delta)
- TextWidth(LeftArr) - TextWidth(RightArr)) { Check text fits }
Do Begin
@@ -1396,11 +1260,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TButton.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CButton; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CButton)] = CButton; { Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Get button palette }
END;
@@ -1455,15 +1315,15 @@ BEGIN
I := (RawSize.X - I) DIV 2; { Centre in button }
End Else I := FontWidth; { Left edge of button }
MoveCStr(Db, Title^, Bc); { Move title to buffer }
-{$ifndef USE_API}
- GOptions := GOptions OR goGraphView; { Graphics co-ords mode }
- WriteLine(I, FontHeight DIV 2, CStrLen(Title^),
- 1, Db); { Write the title }
- GOptions := GOptions AND NOT goGraphView; { Return to normal mode }
-{$else USE_API}
- WriteLine(I div SysFontWidth, 0, CStrLen(Title^),
- 1, Db); { Write the title }
-{$endif USE_API}
+ If not TextModeGFV then Begin
+ GOptions := GOptions OR goGraphView; { Graphics co-ords mode }
+ WriteLine(I, FontHeight DIV 2, CStrLen(Title^),
+ 1, Db); { Write the title }
+ GOptions := GOptions AND NOT goGraphView; { Return to normal mode }
+ End Else Begin
+ WriteLine(I div SysFontWidth, 0, CStrLen(Title^),
+ 1, Db); { Write the title }
+ End;
End;
END;
@@ -1671,11 +1531,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TCluster.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CCluster; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CCluster)] = CCluster; { Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Cluster palette }
END;
@@ -1950,7 +1806,6 @@ BEGIN
Exit; { Now exit }
End;
End;
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
If (Event.CharCode = ' ') AND { Spacebar key }
(State AND sfFocused <> 0) AND { Check focused view }
ButtonState(Sel) Then Begin { Check item enabled }
@@ -1959,7 +1814,6 @@ BEGIN
DrawView; { Now draw changes }
ClearEvent(Event); { Event was handled }
End;
- {$ENDIF}
End;
End;
End;
@@ -2275,7 +2129,6 @@ END;
{ NewList -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TListBox.NewList (AList: PCollection);
-{$IFDEF OS_WINDOWS} VAR I: Integer; S: String; P: PString; {$ENDIF}
BEGIN
If (List <> Nil) Then Dispose(List, Done); { Dispose old list }
List := AList; { Hold new list }
@@ -2348,11 +2201,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TStaticText.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CStaticText; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CStaticText)] = CStaticText; { Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@@ -2509,11 +2358,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TLabel.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CLabel; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CLabel)] = CLabel; { Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@@ -2620,11 +2465,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION THistoryViewer.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CHistoryViewer; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CHistoryViewer)] = CHistoryViewer;{ Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@@ -2684,11 +2525,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION THistoryWindow.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CHistoryWindow; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CHistoryWindow)] = CHistoryWindow;{ Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Return the palette }
END;
@@ -2739,11 +2576,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION THistory.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CHistory; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CHistory)] = CHistory; { Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Return the palette }
END;
@@ -2816,11 +2649,7 @@ BEGIN
If (C = cmOk) Then Begin { Result was okay }
Rslt := HistoryWindow^.GetSelection; { Get history selection }
If Length(Rslt) > Link^.MaxLen Then
- {$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
SetLength(Rslt, Link^.MaxLen); { Hold new length }
- {$ELSE}
- Rslt[0] := Char(Link^.MaxLen); { Hold new length }
- {$ENDIF}
Link^.Data^ := Rslt; { Hold new selection }
Link^.SelectAll(True); { Select all string }
Link^.DrawView; { Redraw link view }
@@ -2881,7 +2710,10 @@ END;
END.
{
$Log$
- Revision 1.7 2001-05-07 22:22:03 pierre
+ Revision 1.8 2001-05-10 16:46:27 pierre
+ + some improovements made
+
+ Revision 1.7 2001/05/07 22:22:03 pierre
* removed NO_WINDOW cond, added GRAPH_API
Revision 1.6 2001/05/04 10:46:01 pierre
@@ -2898,6 +2730,16 @@ END.
Revision 1.2 2000/08/24 12:00:20 marco
* CVS log and ID tags
-
-
}
+{******************[ REVISION HISTORY ]********************}
+{ Version Date Fix }
+{ ------- --------- --------------------------------- }
+{ 1.00 11 Nov 96 First DOS/DPMI platform release. }
+{ 1.10 13 Jul 97 Windows platform code added. }
+{ 1.20 29 Aug 97 Platform.inc sort added. }
+{ 1.30 13 Oct 97 Delphi 2 32 bit code added. }
+{ 1.40 05 May 98 Virtual pascal 2.0 code added. }
+{ 1.50 27 Oct 99 All objects completed and checked }
+{ 1.51 03 Nov 99 FPC windows support added }
+{ 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }
+{**********************************************************}
diff --git a/fv/drivers.pas b/fv/drivers.pas
index 307c2d483d..fed218c85b 100644
--- a/fv/drivers.pas
+++ b/fv/drivers.pas
@@ -27,43 +27,9 @@
{ ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. }
{ }
{*****************[ SUPPORTED PLATFORMS ]******************}
-{ 16 and 32 Bit compilers }
-{ DOS - Turbo Pascal 7.0 + (16 Bit) }
-{ DPMI - Turbo Pascal 7.0 + (16 Bit) }
-{ - FPC 0.9912+ (GO32V2) (32 Bit) }
-{ WINDOWS - Turbo Pascal 7.0 + (16 Bit) }
-{ - Delphi 1.0+ (16 Bit) }
-{ WIN95/NT - Delphi 2.0+ (32 Bit) }
-{ - Virtual Pascal 2.0+ (32 Bit) }
-{ - Speedsoft Sybil 2.0+ (32 Bit) }
-{ - FPC 0.9912+ (32 Bit) }
-{ OS2 - Virtual Pascal 1.0+ (32 Bit) }
-{ - Speed Pascal 1.0+ (32 Bit) }
{ }
-{******************[ REVISION HISTORY ]********************}
-{ Version Date Fix }
-{ ------- --------- --------------------------------- }
-{ 1.00 26 Jul 96 First DOS/DPMI platform release }
-{ 1.10 18 Nov 97 Windows conversion added. }
-{ 1.20 29 Aug 97 Platform.inc sort added. }
-{ 1.30 10 Jun 98 Virtual pascal 2.0 code added. }
-{ 1.40 13 Jul 98 Added FormatStr by Marco Schmidt. }
-{ 1.50 14 Jul 98 Fixed width = 0 in FormatStr. }
-{ 1.60 13 Aug 98 Complete rewrite of FormatStr. }
-{ 1.70 10 Sep 98 Added mouse int hook for FPC. }
-{ 1.80 10 Sep 98 Checks run & commenting added. }
-{ 1.90 15 Oct 98 Fixed for FPC version 0.998 }
-{ 1.91 18 Feb 99 Added PrintStr functions }
-{ 1.92 18 Feb 99 FormatStr literal '%' fix added }
-{ 1.93 10 Jul 99 Sybil 2.0 code added }
-{ 1.94 15 Jul 99 Fixed for FPC 0.9912 release }
-{ 1.95 26 Jul 99 Windows..Scales to GFV system font }
-{ 1.96 30 Jul 99 Fixed Ctrl+F1..F10 in GetKeyEvent }
-{ 1.97 07 Sep 99 InitEvent, DoneEvent fixed for OS2 }
-{ 1.98 09 Sep 99 GetMouseEvent fixed for OS2. }
-{ 1.99 03 Nov 99 FPC windows support added. }
-{ 2.00 26 Nov 99 Graphics stuff moved to GFVGraph }
-{ 2.01 21 May 00 DOS fixed to use std GRAPH unit }
+{ Only Free Pascal Compiler supported }
+{ }
{**********************************************************}
UNIT Drivers;
@@ -78,17 +44,6 @@ UNIT Drivers;
{==== Compiler directives ===========================================}
-{$IFNDEF PPC_FPC} { FPC doesn't support these switches }
- {$F+} { Force far calls - Used because of the ShowMouseProc etc... }
- {$A+} { Word Align Data }
- {$B-} { Allow short circuit boolean evaluations }
- {$O-} { This unit may >>> NOT <<< be overlaid }
- {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
- {$P-} { Normal string variables }
- {$N-} { No 80x87 code generation }
- {$E+} { Emulation is on }
-{$ENDIF}
-
{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
{$IFNDEF OS_LINUX}
@@ -101,21 +56,7 @@ UNIT Drivers;
USES
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
- {$IFNDEF PPC_SPEED} { NON SPEED COMPILER }
- {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
Windows, { Standard unit }
- {$ELSE} { OTHER COMPILERS }
- WinTypes, WinProcs, Strings, { Standard units }
- {$IFDEF BIT_16} { 16 BIT WINDOWS COMPILER }
- Win31, { Standard unit }
- {$ENDIF}
- {$ENDIF}
- {$IFDEF PPC_DELPHI} { DELPHI3+ COMPILER }
- SysUtils, Messages, { Standard unit }
- {$ENDIF}
- {$ELSE} { SYBIL2+ COMPILER }
- WinBase, WinDef, WinUser, WinGDI, { Standard units }
- {$ENDIF}
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
@@ -133,18 +74,10 @@ USES
{$else}
unix,
{$endif}
- {$DEFINE Use_API}
{$ENDIF}
- {$ifdef Use_API}
video,
- {$endif Use_API}
GFVGraph, { GFV graphics unit }
- {$ifndef Use_API}
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
- Graph, { Standard bp unit }
- {$ENDIF}
- {$endif not Use_API}
Common, Objects; { GFV standard units }
{***************************************************************************}
@@ -582,50 +515,9 @@ PROCEDURE NextQueuedEvent(Var Event: TEvent);
{ INITIALIZED PUBLIC VARIABLES }
{***************************************************************************}
-{---------------------------------------------------------------------------}
-{ INITIALIZED DOS/DPMI VARIABLES }
-{---------------------------------------------------------------------------}
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
-{ ******************************* REMARK ****************************** }
-{ In Hi-Res graphics modes where the usual mouse handler will not }
-{ work these can be set so the user can provide his own hide, show }
-{ and redraw on move routines, otherwise leave them set as nil. }
-{ ****************************** END REMARK *** Leon de Boer, 20Jul98 * }
-TYPE DrawProc = PROCEDURE;
-
-CONST
- HideMouseProc: DrawProc = Nil; { Hide mouse procedure }
- ShowMouseProc: DrawProc = Nil; { Show mouse procedure }
- MouseMoveProc: DrawProc = Nil; { Mouse moved procedure }
-{$ENDIF}
-
PROCEDURE HideMouseCursor;
PROCEDURE ShowMouseCursor;
-{---------------------------------------------------------------------------}
-{ INITIALIZED WIN/NT VARIABLES }
-{---------------------------------------------------------------------------}
-{$IFDEF OS_WINDOWS} { WIN/NT CODE }
-CONST
- RawHandler : Boolean = False;
- AppWindow : HWnd = 0; { Application window }
- DefGfvFont : HFont = 0; { Default GFV font }
- DefFontWeight: Integer = fw_Normal; { Default font weight }
- DefFontStyle : String = 'Times New Roman'; { Default font style }
-{$ENDIF}
-
-{---------------------------------------------------------------------------}
-{ INITIALIZED OS2 VARIABLES }
-{---------------------------------------------------------------------------}
-{$IFDEF OS_OS2} { OS2 CODE }
-CONST
- AppWindow : HWnd = 0; { Application window }
- Anchor : HAB = 0; { Anchor block }
- MsgQue : HMq = 0; { Message queue }
- DefGFVFont : LongInt = 0; { Default font style }
- DefPointer : HPointer = 0; { Default pointer }
- DefFontStyle: String = 'Times'; { Default font style }
-{$ENDIF}
{---------------------------------------------------------------------------}
{ INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES }
@@ -672,43 +564,27 @@ VAR
MouseButtons: Byte; { Mouse button state }
ScreenWidth : Byte; { Screen text width }
ScreenHeight: Byte; { Screen text height }
-{$ifndef Use_API}
+{$ifdef GRAPH_API}
ScreenMode : Word; { Screen mode }
-{$else Use_API}
+{$else not GRAPH_API}
ScreenMode : TVideoMode; { Screen mode }
-{$endif Use_API}
+{$endif GRAPH_API}
MouseWhere : TPoint; { Mouse position }
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
-{$ifdef Use_API}
{ API Units }
USES Keyboard,Mouse;
-{$else not Use_API}
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
- {$IFDEF PPC_FPC} { FPC DOS COMPILER }
- USES Go32; { Standard unit }
- {$ENDIF}
-{$ENDIF}
-{$endif not Use_API}
{***************************************************************************}
{ PRIVATE INTERNAL CONSTANTS }
{***************************************************************************}
-{$IFDEF OS_DOS} { DOS/DPMI/API CODE }
-{$define Has_vars}
-{$ENDIF OS_DOS}
-{$IFDEF Use_API}
-{$define Has_vars}
-{$ENDIF Use_API}
-{$IFDEF HAS_VARS} { DOS/DPMI/API CODE }
{---------------------------------------------------------------------------}
{ DOS/DPMI MOUSE INTERRUPT EVENT QUEUE SIZE }
{---------------------------------------------------------------------------}
CONST EventQSize = 16; { Default int bufsize }
-{$ENDIF}
{---------------------------------------------------------------------------}
{ DOS/DPMI/WIN/NT/OS2 NEW EVENT QUEUE MAX SIZE }
@@ -719,79 +595,10 @@ CONST QueueMax = 64; { Max new queue size }
{ PRIVATE INTERNAL TYPES }
{***************************************************************************}
-{$IFDEF OS_WINDOWS} { DOS/DPMI CODE }
-{---------------------------------------------------------------------------}
-{ SYBIL2+ WIN/NT COMPILER TYPE FIX UPS }
-{---------------------------------------------------------------------------}
- {$IFDEF PPC_SPEED} { SYBIL2+ COMPILER }
- TYPE TLogFont = LogFont; { Type fix up }
- TYPE TMsg = Msg; { Type fix up }
- TYPE TTextMetric = TextMetric; { Type fix up }
- {$ENDIF}
-{$ENDIF}
-
{***************************************************************************}
{ PRIVATE INTERNAL INITIALIZED VARIABLES }
{***************************************************************************}
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
-{---------------------------------------------------------------------------}
-{ DOS/DPMI INITIALIZED VARIABLES }
-{---------------------------------------------------------------------------}
- {$IFDEF GO32V2} { GO32V2 needs these }
- CONST
- RealSeg: Word = 0; { Real mode segment }
- RealOfs: Word = 0; { Real mode offset }
- MouseCallback: Pointer = Nil; { Mouse call back ptr }
- {$ENDIF}
-
-{$ENDIF}
-
-{$IFDEF OS_WINDOWS} { WIN/NT CODE }
-{---------------------------------------------------------------------------}
-{ WIN/NT TABLE OF ALT + ASCII CODES FROM VIRTUAL CODES }
-{---------------------------------------------------------------------------}
-CONST AltVirtualToAscii: Array [0..127] Of Word =
- ($00, $00, $00, $00, $00, $00, $00, $00,
- kbAltBack, kbAltTab, $00, $00, $00, kbEnter, $00, $00,
-{10H} $00, $00, $00, $00, $00, $00, $00, $00,
- $00, $00, $00, kbEsc, $00, $00, $00, $00,
-{20H} kbAltSpace, kbAltPgUp, kbAltPgDn, kbAltEnd, kbAltHome,
- kbAltLeft, kbAltUp, kbAltRight,
- kbAltDown, $00, $00, $00, $00, kbAltIns, kbAltDel, $00,
-{30H} kbAlt0, kbAlt1, kbAlt2, kbAlt3, kbAlt4, kbAlt5, kbAlt6, kbAlt7,
- kbAlt8, kbAlt9, $00, $00, $00, $00, $00, $00,
-{40H} $00, kbAltA, kbAltB, kbAltC, kbAltD, kbAltE, kbAltF, kbAltG,
- kbAltH, kbAltI, kbAltJ, kbAltK, kbAltL, kbAltM, kbAltN, kbAltO,
-{50H} kbAltP, kbAltQ, kbAltR, kbAltS, kbAltT, kbAltU, kbAltV, kbAltW,
- kbAltX, kbAltY, kbAltZ, $00, $00, $00, $00, $00,
-{60H} $00, $00, $00, $00, $00, $00, $00, $00,
- $00, $00, $372A, $4E2B, $00, $4A2D, $00, $352F,
-{70H} kbAltF1, kbAltF2, kbAltF3, kbAltF4, kbAltF5, kbAltF6, kbAltF7, kbAltF8,
- kbAltF9, kbAltF10, $00, $00, $00, $00, $00, $00);
-
-{---------------------------------------------------------------------------}
-{ WIN/NT TABLE OF WINDOWS ASCII TO INTERNATIONAL ASCII }
-{---------------------------------------------------------------------------}
-CONST WinAsciiToIntAscii: Array [128..255] Of Byte = (
-{80H} $00, $00, $00, $00, $00, $00, $00, $00,
- $00, $00, $00, $00, $00, $00, $00, $00,
-{90H} $00, $00, $00, $00, $00, $00, $00, $00,
- $00, $00, $00, $00, $00, $00, $00, $00,
-{A0H} $00, $AD, $BD, $9C, $CF, $BE, $B3, $F5,
- $00, $B8, $A6, $AE, $AA, $B0, $A9, $00,
-{B0H} $F8, $F1, $FD, $00, $EF, $E6, $F4, $00,
- $3C, $3E, $A7, $AF, $AC, $AB, $F3, $A8,
-{C0H} $B7, $B5, $B6, $C7, $8E, $8F, $92, $80,
- $D4, $90, $D2, $D3, $DE, $D6, $D7, $D8,
-{D0H} $D1, $A5, $E3, $E0, $E2, $E5, $99, $00,
- $9D, $EB, $E9, $EA, $9A, $ED, $E7, $E1,
-{E0H} $85, $A0, $83, $C6, $84, $86, $91, $87,
- $8A, $82, $88, $89, $8D, $A1, $8C, $8B,
-{F0H} $D0, $A4, $95, $A2, $93, $E4, $94, $F6,
- $9B, $97, $A3, $96, $81, $EC, $E8, $98);
-{$ENDIF}
-
{---------------------------------------------------------------------------}
{ DOS/DPMI/WIN/NT/OS2 ALT KEY SCANCODES FROM KEYS (0-127) }
{---------------------------------------------------------------------------}
@@ -830,7 +637,6 @@ CONST
{ PRIVATE INTERNAL UNINITIALIZED VARIABLES }
{***************************************************************************}
-{$ifdef Has_vars}
{---------------------------------------------------------------------------}
{ UNINITIALIZED DOS/DPMI/API VARIABLES }
{---------------------------------------------------------------------------}
@@ -853,23 +659,6 @@ VAR
EventQueue : Array [0..EventQSize - 1] Of TEvent; { Event queue }
EventQLast : RECORD END; { Simple end marker }
-{---------------------------------------------------------------------------}
-{ ABSOLUTE PRIVATE DOS/DPMI ADDRESS VARIABLES }
-{---------------------------------------------------------------------------}
- {$ifdef OS_DOS}
- {$IFNDEF GO32V1}
-VAR
- ShiftState: Byte Absolute $40:$17; { Shift state mask }
- Ticks: Word Absolute $40:$6C; { DOS tick counter }
- {$ENDIF}
- {$endif OS_DOS}
-
- {$IFDEF GO32V2} { GO32V2 registers }
-VAR
- ActionRegs: TRealRegs; { Real mode registers }
- {$ENDIF}
-
-{$ENDIF Has_Vars}
{---------------------------------------------------------------------------}
{ GetDosTicks (18.2 Hz) }
@@ -917,422 +706,6 @@ VAR
{ PRIVATE INTERNAL ROUTINES }
{***************************************************************************}
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-{ DOS/DPMI ONLY PRIVATE INTERNAL ROUTINES }
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
-
-{$IFDEF GO32V2} { GO32V2 CODE }
-{---------------------------------------------------------------------------}
-{ MouseTrap -> Platforms GO32V2 - FPC COMPILER Updated 10Sep98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE Mouse_Trap; FAR; ASSEMBLER;
-ASM
- PUSH %ES; { Save ES register }
- PUSH %DS; { Save DS register }
- PUSHL %EDI; { Save register }
- PUSHL %ESI; { Save register }
- ;{ caution : ds is not the selector for our data !! }
- PUSH %ES; { Push data seg }
- POP %DS; { Load data seg }
- PUSHL %EDI; { Actionregs address }
- MOVL MOUSECALLBACK, %EAX; { Fetch callback addr }
- CMPL $0, %EAX; { Check for nil ptr }
- JS .L_NoCallBack; { Ignore if nil }
- POPL %EAX; { %EAX = @actionregs }
- MOVL (%EAX), %EDI; { EDI from actionregs }
- MOVL 4(%EAX), %ESI; { ESI from actionregs }
- MOVL 16(%EAX), %EBX; { EBX from actionregs }
- MOVL 20(%EAX), %EDX; { EDX from actionregs }
- MOVL 24(%EAX), %ECX; { ECX from actionregs }
- MOVL 28(%EAX), %EAX; { EAX from actionregs }
- CALL *MOUSECALLBACK; { Call callback proc }
-.L_NoCallBack:
- POPL %ESI; { Recover register }
- POPL %EDI; { Recover register }
- POP %DS; { Restore DS register }
- POP %ES; { Restore ES register }
- MOVL (%ESI), %EAX;
- MOVL %EAX, %ES:42(%EDI); { Set as return addr }
- ADDW $4, %ES:46(%EDI); { adjust stack }
- IRET; { Interrupt return }
-END;
-{$ENDIF}
-
-{$IFDEF PPC_FPC} { FPC COMPILER CODE }
-{$ifndef Use_API}
-{---------------------------------------------------------------------------}
-{ Mouse_Action -> Platforms DPMI - FPC COMPILER Updated 10Sep98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE Mouse_Action (Mask : Integer; P : Pointer);
-VAR Error: Word; ErrStr: String; {$IFDEF GO32V2} Rg: TRealRegs; {$ENDIF}
-BEGIN
- {$IFDEF GO32V1} { GO32V1 CODE }
- ErrStr := 'GO32V1 mouse handler set failed !!'; { Set error string }
- ASM
- MOVL $0xFF, %EAX; { GO32v1 special id }
- MOVL P, %ECX; { Fuction to chain }
- MOVL $0x20, %EBX; { Event queue size > 0 }
- MOVL $0x12345678, %EDX; { Test for version ? }
- INT $0x33; { Call special wrapper }
- CMPW $0xFF0, %AX; { AX=$FF0 if success }
- JNZ .L_GO32V1Err;
- MOVW $0, %AX; { Zero register }
- JMP .LGO32V1Ok; { Now jump over }
- .L_GO32V1Err:
- MOVW $0xFFFF, %AX; { -1 to register }
- .L_GO32V1Ok:
- MOVW %AX, Error; { Set error result }
- END;
- {$ENDIF}
- {$IFDEF GO32V2} { GO32V2 CODE }
- Error := 0; { Preset no error }
- ErrStr := 'GO32V2 mouse handler set failed !!'; { Set error string }
- If (P <> MouseCallBack) Then Begin { Check func different }
- If (RealSeg <> 0) Then Begin { Remove old calback }
- Rg.AX := 12; { Function id }
- Rg.CX := 0; { Zero mask register }
- Rg.ES := 0; { Zero proc seg }
- Rg.DX := 0; { Zero proc ofs }
- RealIntr($33, Rg); { Stop INT 33 callback }
- ASM
- MOVW $0x304, %AX; { Set function id }
- MOVW REALSEG, %CX; { Bridged real seg }
- MOVW REALOFS, %DX; { Bridged real ofs }
- INT $0x31; { Release bridge }
- END;
- End;
- MouseCallback := P; { Set call back addr }
- If (P <> Nil) Then Begin { Check non nil proc }
- ASM
- LEAL ACTIONREGS, %EDI; { Addr of actionregs }
- LEAL MOUSE_TRAP, %ESI; { Procedure address }
- PUSH %DS; { Save DS segment }
- PUSH %ES; { Save ES segment }
- PUSH %DS;
- POP %ES; { ES now has dataseg }
- PUSH %CS;
- POP %DS; { DS now has codeseg }
- MOVW $0x303, %AX; { Function id }
- INT $0x31; { Call DPMI bridge }
- POP %ES; { Restore ES segment }
- POP %DS; { Restore DS segment }
- MOVW %CX, REALSEG; { Transfer real seg }
- MOVW %DX, REALOFS; { Transfer real ofs }
- MOVW $0, %AX; { Preset zero error }
- JNC .L_call_ok; { Branch if ok }
- MOVW $0xFFFF, %AX; { Force a -1 error }
- .L_call_ok:
- MOVW %AX, ERROR; { Return error state }
- END;
- Rg.CX := Mask; { Set mask register }
- End Else Begin
- Rg.EDI := 0; { Zero proc register }
- Rg.CX := 0; { Zero mask register }
- End;
- If (Error = 0) Then Begin { If no error }
- Rg.AX := 12; { Set function id }
- Rg.ES := RealSeg; { Real mode segment }
- Rg.DX := RealOfs; { Real mode offset }
- RealIntr($33, Rg); { Set interrupt 33 }
- End Else Begin
- RealSeg := 0; { Zero real mode seg }
- RealOfs := 0; { Zero real mode ofs }
- End;
- End;
- {$ENDIF}
- If (Error <> 0) Then Begin { Error encountered }
- WriteLn(ErrStr); { Write error }
- ReadLn; { Wait for user to see }
- End;
-END;
-
-{$ENDIF}
-
-{---------------------------------------------------------------------------}
-{ MouseInt -> Platforms DOS/DPMI - Updated 30Jun98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE MouseInt; FAR; ASSEMBLER;
-{$IFDEF ASM_BP} { BP COMPATABLE ASM }
-ASM
- MOV SI, SEG @DATA; { Fetch data segment }
- MOV DS, SI; { Fix data segment }
- MOV SI, CX; { Transfer x position }
- MOV MouseButtons, BL; { Update mouse buttons }
- MOV MouseWhere.X, SI; { Update x position }
- MOV MouseWhere.Y, DX; { Update y position }
- CMP EventCount, EventQSize; { Check if queue full }
- JZ @@QueueFull; { Queue is full exit }
- MOV ES, Seg0040; { Fetch DOS segment }
- MOV AX, ES:Ticks; { Fetch dos tick count }
- MOV DI, WORD PTR EventQTail; { Address of tail }
- PUSH DS; { Push to stack }
- POP ES; { ES to data segment }
- CLD; { Store forward }
- STOSW; { Store tick count }
- XCHG AX, BX; { Transfer register }
- STOSW; { Store button state }
- XCHG AX, SI; { Transfer register }
- STOSW; { Store x position }
- XCHG AX, DX; { Transfer register }
- STOSW; { Store y position }
- CMP DI, OFFSET EventQLast; { Roll if at queue end }
- JNE @@NoRollNeeded; { Not at queue end }
- MOV DI, OFFSET EventQueue; { Roll back to start }
-@@NoRollNeeded:
- MOV WORD PTR EventQTail, DI; { Update queue tail }
- INC EventCount; { One message added }
-@@QueueFull:
- MOV MouseIntFlag, 1; { Set interrupt flag }
- MOV SI, WORD PTR MouseMoveProc; { Low address word }
- OR SI, WORD PTR MouseMoveProc+2; { "OR" high word }
- JZ @@Exit; { No move call so exit }
- DB $66; PUSH AX; { Store EAX }
- DB $66; PUSH BX; { Store EBX }
- DB $66; PUSH CX; { Store ECX }
- DB $66; PUSH DX; { Store EDX }
- DB $66; PUSH SI; { Store ESI }
- DB $66; PUSH DI; { Store EDI }
- DB $66; PUSH BP; { Store EBP }
- PUSH ES; { Store ES }
- PUSH BP; { Standard BP push }
- MOV BP, SP; { Transfer stack ptr }
- CALL MouseMoveProc; { Standard procedure }
- POP BP; { Standard BP recover }
- POP ES; { Recover ES }
- DB $66; POP BP; { Recover EBP }
- DB $66; POP DI; { Recover EDI }
- DB $66; POP SI; { Recover ESI }
- DB $66; POP DX; { Recover EDX }
- DB $66; POP CX; { Recover ECX }
- DB $66; POP BX; { Recover EBX }
- DB $66; POP AX; { Recover EAX }
-@@Exit:
-END;
-{$ENDIF}
-{$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
-ASM
- MOVW %CX, %SI; { Transfer x position }
- MOVB %BL, MOUSEBUTTONS; { Update mouse buttons }
- MOVW %SI, MOUSEWHERE; { Update x position }
- MOVW %DX, MOUSEWHERE+2; { Update y position }
- CMPW $16, EVENTCOUNT; { Check if queue full }
- JZ .L_QueueFull; { Queue is full exit }
- PUSH %ES; { Save segment }
- MOVW $0x40, %AX; { Fetch DOS segment }
- MOVW %AX, %ES; { Transfer to segment }
- MOVL $0x6C, %EDI; { Address of ticks }
- MOVW %ES:(%EDI), %AX; { Fetch dos tick count }
- POP %ES; { Recover segment }
- MOVL EVENTQTAIL, %EDI; { Queue tail address }
- CLD; { Store forward }
- STOSW; { Store tick count }
- XCHGW %BX, %AX; { Transfer register }
- STOSW; { Store button state }
- XCHGW %SI, %AX; { Transfer register }
- STOSW; { Store x position }
- XCHGW %DX, %AX; { Transfer register }
- STOSW; { Store y position }
- LEAL EVENTQLAST, %EAX; { Roll point address }
- CMPL %EAX, %EDI; { Roll if at queue end }
- JNE .L_NoRollNeeded; { Not at queue end }
- LEAL EVENTQUEUE, %EDI; { Roll back to start }
-.L_NoRollNeeded:
- MOVL %EDI, EVENTQTAIL; { Update queue tail }
- INCW EVENTCOUNT; { One message added }
-.L_QueueFull:
- MOVB $1, MOUSEINTFLAG; { Set interrupt flag }
- MOVL MOUSEMOVEPROC, %EAX; { Load proc address }
- CMPL $0, %EAX; { Check for nil ptr }
- JZ .L_Exit; { No move call so exit }
- PUSHL %EAX; { Store EAX }
- PUSHL %EBX; { Store EBX }
- PUSHL %ECX; { Store ECX }
- PUSHL %EDX; { Store EDX }
- PUSHL %ESI; { Store ESI }
- PUSHL %EDI; { Store EDI }
- PUSHL %EBP; { Store EBP }
- PUSH %ES; { Store ES }
- CALL %EAX; { Standard procedure }
- POP %ES; { Recover ES }
- POPL %EBP; { Recover EBP }
- POPL %EDI; { Recover EDI }
- POPL %ESI; { Recover ESI }
- POPL %EDX; { Recover EDX }
- POPL %ECX; { Recover ECX }
- POPL %EBX; { Recover EBX }
- POPL %EAX; { Recover EAX }
-.L_Exit:
-END;
-{$ENDIF}
-{$endif not Use_API}
-
-{---------------------------------------------------------------------------}
-{ HideMouseCursor -> Platforms DOS/DPMI - Updated 10Sep98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE HideMouseCursor; ASSEMBLER;
-{$IFDEF ASM_BP} { BP COMPATABLE ASM }
-ASM
- CMP MouseEvents, 0; { Check mouse system }
- JZ @@Exit; { Branch if not active }
- MOV AX, WORD PTR [HideMouseProc]; { Fetch offset of addr }
- OR AX, WORD PTR [HideMouseProc+2]; { Check for nil ptr }
- JZ @@UseMouseInt; { Branch if nil }
- CALL FAR PTR [HideMouseProc]; { Call hide mouse }
- JMP @@Exit; { Now exit }
-@@UseMouseInt:
- MOV AX, $2; { Load function id }
- PUSH BP; { Safety!! save reg }
- INT $33; { Hide the mouse }
- POP BP; { Restore register }
-@@Exit:
-END;
-{$ENDIF}
-{$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
-ASM
- CMPB $0, MouseEvents; { Check mouse system }
- JZ .L_Exit; { Branch if not active }
- MOVL HideMouseProc, %EAX; { Fetch address }
- ORL %EAX, %EAX; { Check for nil ptr }
- JZ .L_UseMouseInt; { Branch if nil }
- CALL HideMouseProc; { Call show mouse }
- JMP .L_Exit; { Now exit }
-.L_UseMouseInt:
- MOVW $2, %AX; { Load function id }
- PUSHL %EBP; { Save regigister }
- INT $0x33; { Hide the mouse }
- POPL %EBP; { Restore register }
-.L_Exit:
-END;
-{$ENDIF}
-
-{---------------------------------------------------------------------------}
-{ ShowMouseCursor -> Platforms DOS/DPMI - Updated 10Sep98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE ShowMouseCursor; ASSEMBLER;
-{$IFDEF ASM_BP} { BP COMPATABLE ASM }
-ASM
- CMP MouseEvents, 0; { Check mouse system }
- JZ @@Exit; { Branch if not active }
- MOV AX, WORD PTR [ShowMouseProc]; { Fetch offset of addr }
- OR AX, WORD PTR [ShowMouseProc+2]; { Check for nil ptr }
- JZ @@UseMouseInt; { Branch if nil }
- CALL FAR PTR [ShowMouseProc]; { Call show mouse }
- JMP @@Exit; { Now exit }
-@@UseMouseInt:
- MOV AX, $1; { Load function id }
- PUSH BP; { Safety!! save reg }
- INT $33; { Show the mouse }
- POP BP; { Restore register }
-@@Exit:
-END;
-{$ENDIF}
-{$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
-ASM
- CMPB $0, MouseEvents; { Check mouse system }
- JZ .L_Exit; { Branch if not active }
- MOVL ShowMouseProc, %EAX; { Fetch address }
- ORL %EAX, %EAX; { Check for nil ptr }
- JZ .L_UseMouseInt; { Branch if nil }
- CALL ShowMouseProc; { Call show mouse }
- JMP .L_Exit; { Now exit }
-.L_UseMouseInt:
- MOVW $1, %AX; { Load function id }
- PUSHL %EBP; { Save regigister }
- INT $0x33; { Hide the mouse }
- POPL %EBP; { Restore register }
-.L_Exit:
-END;
-{$ENDIF}
-
-
-{$ifndef Use_API}
-{---------------------------------------------------------------------------}
-{ HookMouse -> Platforms DOS/DPMI - Updated 27Aug98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE HookMouse;
-BEGIN
- {$IFDEF ASM_BP} { BP COMPTABABLE ASM }
- ASM
- MOV AX, $000C; { Set user interrupt }
- MOV CX, $FFFF; { For all event masks }
- MOV DX, OFFSET CS:MouseInt; { Mouse int is hook }
- PUSH CS; { Push code segment }
- POP ES; { ES:DX -> MouseInt }
- PUSH BP; { Safety!! save reg }
- INT $33; { Hook the routine }
- POP BP; { Restore register }
- END;
- {$ENDIF}
- {$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
- {$IFDEF GO32V2} { GO32V2 CODE }
- Lock_Code(Pointer(@Mouse_Trap), 400); { Lock trap code }
- Lock_Data(ActionRegs, SizeOf(ActionRegs)); { Lock registers }
- {$ENDIF}
- Mouse_Action(-1, @MouseInt); { Set masks/interrupt }
- {$ENDIF}
-END;
-
-
-{---------------------------------------------------------------------------}
-{ UnHookMouse -> Platforms DOS/DPMI - Updated 27Aug98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE UnHookMouse;
-BEGIN
- {$IFDEF ASM_BP} { BP COMPATABLE ASM }
- ASM
- MOV AX, $000C; { Set user interrupt }
- XOR CX, CX; { Clear all masks }
- XOR DX, DX; { Clear register }
- MOV ES, CX; { ES:DX -> Nil }
- PUSH BP; { Safety!! save reg }
- INT $33; { Release mouse hook }
- POP BP; { Restore register }
- END;
- {$ENDIF}
- {$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
- Mouse_Action(0, Nil); { Clear mask/interrupt }
- {$IFDEF GO32V2} { GO32V2 CODE }
- Unlock_Code(Pointer(@Mouse_Trap), 400); { Release trap code }
- Unlock_Data(ActionRegs, SizeOf(TRealRegs)); { Release registers }
- {$ENDIF}
- {$ENDIF}
-END;
-
-{---------------------------------------------------------------------------}
-{ GetMousePosition -> Platforms DOS/DPMI - Updated 19May98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE GetMousePosition (Var X, Y: sw_Integer); ASSEMBLER;
-{$IFDEF ASM_BP} { BP COMPATABLE ASM }
-ASM
- MOV AX, $3; { Set function id }
- PUSH BP; { Safety!! save reg }
- INT $33; { Get button data }
- POP BP; { Restore register }
- LES DI, X; { Adress of x }
- MOV ES:[DI], CX; { Return x position }
- LES DI, Y; { Adress of y }
- MOV ES:[DI], DX; { Return y position }
-END;
-{$ENDIF}
-{$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
-ASM
- MOVW $3, %AX; { Set function id }
- PUSHL %EBP; { Save register }
- INT $0x33; { Get button data }
- POPL %EBP; { Restore register }
- MOVL X, %EDI; { Adress of x }
- MOVW %CX, (%EDI); { Return x position }
- MOVL Y, %EDI; { Adress of y }
- MOVW %DX, (%EDI); { Return y position }
-END;
-{$ENDIF}
-{$endif not Use_API}
-
-{$ENDIF}
-
-{$IFDEF USE_API}
-{$IFNDEF OS_DOS}
PROCEDURE ShowMouseCursor;
BEGIN
ShowMouse;
@@ -1343,9 +716,6 @@ BEGIN
HideMouse;
END;
-{$ENDIF not OS_DOS}
-{$ENDIF USE_API}
-
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ DOS/DPMI/WIN/NT/OS2 PRIVATE INTERNAL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -1357,10 +727,8 @@ PROCEDURE ExitDrivers; {$IFNDEF OS_LINUX} FAR; {$ENDIF}
BEGIN
DoneSysError; { Relase error trap }
DoneEvents; { Close event driver }
-{$ifdef Use_API}
DoneKeyboard;
DoneVideo;
-{$endif Use_API}
ExitProc := SaveExit; { Restore old exit }
END;
@@ -1481,70 +849,10 @@ END;
{---------------------------------------------------------------------------}
{ DetectMouse -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB }
-{$ifdef Use_API}
FUNCTION DetectMouse: Byte;
begin
DetectMouse:=Mouse.DetectMouse;
end;
-{$else not Use_API}
-{---------------------------------------------------------------------------}
-FUNCTION DetectMouse: Byte;
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
- {$IFDEF ASM_BP} { BP COMPATABLE ASM }
- ASSEMBLER;
- ASM
- MOV AX, $3533; { Set function id }
- PUSH BP; { Safety!! save reg }
- INT $21; { Get mouse interrupt }
- POP BP; { Restore register }
- MOV AX, ES; { Transfer register }
- OR AX, BX; { Check for nil ptr }
- JZ @@Exit2; { Jump no mouse driver }
- XOR AX, AX; { Set function id }
- PUSH BP; { Safety!! save reg }
- INT $33; { Reset mouse }
- POP BP; { Restore register }
- OR AX, AX; { Check for success }
- JZ @@Exit2; { Reset mouse failed }
- MOV AX, BX; { Return button count }
- @@Exit2:
- END;
- {$ENDIF}
- {$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
- ASSEMBLER;
- ASM
- MOVW $0x200, %AX; { Get real mode int }
- MOVW $0x33, %BX; { Vector 33H }
- PUSHL %EBP; { Save register }
- INT $0x31; { Get the address }
- POPL %EBP; { Restore register }
- MOVW %CX, %AX; { Transfer register }
- ORW %DX, %AX; { Check for nil ptr }
- JZ .L_Exit2; { Jump no mouse driver }
- XORW %AX, %AX; { Set function id }
- PUSHL %EBP; { Save register }
- INT $0x33; { Reset mouse driver }
- POPL %EBP; { Restore register }
- ORW %AX, %AX; { Check for success }
- JZ .L_Exit2; { Reset mouse failed }
- MOVW %BX, %AX; { Return button count }
- .L_Exit2:
- END;
- {$ENDIF}
-{$ENDIF}
-{$IFDEF OS_WINDOWS} { WIN/NT CODE }
-BEGIN
- If (GetSystemMetrics(sm_MousePresent) <> 0) Then
- DetectMouse := 2 Else DetectMouse := 0; { Buttons present }
-END;
-{$ENDIF}
-{$IFDEF OS_OS2} { OS2 CODE }
-BEGIN
- DetectMouse := WinQuerySysValue(HWND_Desktop,
- SV_CMouseButtons); { Buttons present }
-END;
-{$ENDIF}
-{$endif not Use_API}
{***************************************************************************}
{ INTERFACE ROUTINES }
@@ -1703,7 +1011,6 @@ BEGIN
End;
END;
-{$ifdef Use_API}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ KEYBOARD CONTROL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -1856,604 +1163,6 @@ begin
FillChar(Event,sizeof(TEvent),0);
end;
-{$else not Use_API}
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-{ KEYBOARD CONTROL ROUTINES }
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-
-{---------------------------------------------------------------------------}
-{ GetShiftState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Jul96 LdB }
-{---------------------------------------------------------------------------}
-FUNCTION GetShiftState: Byte;
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
- {$IFDEF ASM_BP} { BP COMPATABLE ASM }
- ASSEMBLER;
- ASM
- MOV ES, Seg0040; { Load DOS segment }
- XOR AX, AX;
- MOV DX, AX; { Clear registers }
- MOV AL, ES:[$0017]; { Read shift state }
- END;
- {$ENDIF}
- {$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
- BEGIN
- ASM
- MOVW $0x0200, %AX; { Set function id }
- PUSHL %EBP; { Save register }
- INT $0x16; { Get shift status }
- POPL %EBP; { Restore register }
- END;
- END;
- {$ENDIF}
-{$ENDIF}
-{$IFDEF OS_WINDOWS} { WIN/NT CODE }
-CONST vk_Scroll = $91; { Borland forgot this! }
-VAR B: Byte;
-BEGIN
- B := 0; { Clear all masks }
- If (GetKeyState(vk_Shift) AND $80 <> 0) Then
- B := B OR kbBothShifts; { Set both shifts }
- If (GetKeyState(vk_Control) AND $80 <> 0) Then
- B := B OR kbCtrlShift; { Set control mask }
- If (GetKeyState(vk_Menu) AND $80 <> 0) Then
- B := B OR kbAltShift; { Set alt mask }
- If (GetKeyState(vk_Scroll) AND $81 <> 0) Then
- B := B OR kbScrollState; { Set scroll lock mask }
- If (GetKeyState(vk_NumLock) AND $81 <> 0) Then
- B := B OR kbNumState; { Set number lock mask }
- If (GetKeyState(vk_Capital) AND $81 <> 0) Then
- B := B OR kbCapsState; { Set caps lock mask }
- If (GetKeyState(vk_Insert) AND $81 <> 0) Then
- B := B OR kbInsState; { Set insert mask }
- GetShiftState := B; { Return masks }
-END;
-{$ENDIF}
-{$IFDEF OS_OS2} { OS2 CODE }
-VAR Key: KbdInfo;
-BEGIN
- Key.cb := SizeOf(Key); { Keyboard size }
- If KbdGetStatus(Key, 0) = 0 Then { Get key status }
- GetShiftState := Key.fsState Else { Return shift state }
- GetShiftState := 0; { Failed so return 0 }
-END;
-{$ENDIF}
-
-{---------------------------------------------------------------------------}
-{ GetKeyEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE GetKeyEvent (Var Event: TEvent);
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
-ASSEMBLER;
- {$IFDEF ASM_BP} { BP COMPATABLE ASM }
- ASM
- MOV AH, $1; { Set function id }
- PUSH BP; { Safety!! save reg }
- INT $16; { Check for keypress }
- POP BP; { Restore register }
- MOV AX, $0; { Zero register AX }
- MOV BX, AX; { Zero register BX }
- JZ @@Exit3; { No keypress jump }
- MOV AH, $00; { Set function id }
- PUSH BP; { Safety!! save reg }
- INT $16; { Read the key }
- POP BP; { Restore register }
- XCHG AX, BX; { Exchange registers }
- MOV AX, evKeyDown; { Set keydown event }
- @@Exit3:
- LES DI, Event; { ES:DI -> Event }
- MOV ES:[DI].TEvent.What, AX; { Store event mask }
- MOV ES:[DI].TEvent.KeyCode, BX; { Store key code }
- END;
- {$ENDIF}
- {$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
- ASM
- MOVB $1, %AH; { Set function id }
- PUSHL %EBP; { Save register }
- INT $0x16; { Check for keypress }
- POPL %EBP; { Restore register }
- MOVW $0x0, %AX; { Zero register AX }
- MOVW %AX, %BX; { Zero register BX }
- JZ .L_Exit3; { No keypress jump }
- MOVB $0, %AH; { Set function id }
- PUSHL %EBP; { Save register }
- INT $0x16; { Read the key }
- POPL %EBP; { Restore register }
- XCHGW %BX, %AX; { Exchange registers }
- MOVW $0x10, %AX; { Set keydown event }
- .L_Exit3:
- MOVL Event, %EDI; { EDI -> Event }
- CLD;
- STOSW; { Store event mask }
- XCHGW %BX, %AX; { Transfer key code }
- STOSW; { Store key code }
- END;
- {$ENDIF}
-{$ENDIF}
-{$IFDEF OS_WINDOWS} { WIN/NT CODE }
-CONST NumPos: Byte = 0; Numeric: Byte = 0;
-VAR Handled: Boolean; B: Byte; Msg: TMsg;
-BEGIN
- Event.What := evNothing; { Preset no event }
- {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
- If (PeekMessage(@Msg, 0, 0, WM_MouseFirst-1, pm_Remove)
- OR PeekMessage(@Msg, 0, WM_MouseLast+1, $FFFF, pm_Remove))
- {$ELSE} { OTHER COMPILERS }
- If (PeekMessage(Msg, 0, 0, WM_MouseFirst-1, pm_Remove)
- OR PeekMessage(Msg, 0, WM_MouseLast+1, $FFFF, pm_Remove))
- {$ENDIF}
- Then Begin { Non mouse message }
- Handled := False; { Preset not handled }
- Case Msg.Message Of
- WM_Char: Begin { CHARACTER KEY }
- NumPos := 0; { Zero number position }
- Event.CharCode := Char(Msg.wParam); { Transfer character }
- If (Event.CharCode > #127) Then
- Event.CharCode := Chr(WinAsciiToIntAscii[
- Ord(Event.CharCode)]); { Convert to ascii }
- Event.ScanCode := Lo(HiWord(Msg.lParam)); { Transfer scan code }
- If (Event.CharCode <> #0) Then Begin { If valid key then }
- Event.What := evKeyDown; { Key down event }
- Handled := True; { Message was handled }
- If (Event.KeyCode = kbTab) AND { Tab key is special }
- (GetShiftState AND kbBothShifts <> 0) Then { Check shift state }
- Event.KeyCode := kbShiftTab; { If set make shifttab }
- End;
- End;
- WM_SysKeyDown: Begin { SYSTEM KEY DOWN }
- If (NumPos > 0) Then Begin { Numerics entry op }
- Case Msg.wParam Of
- VK_Insert: Begin { Insert key }
- If (GetShiftState AND kbAltShift <> 0) { Alt key down }
- Then Begin
- Event.What := evKeyDown; { Key down event }
- Event.KeyCode := kbAltIns; { Alt + Ins key }
- Handled := True; { Set key handled }
- Exit; { Now exit }
- End;
- B := 0; { Key value = 0 }
- End;
- VK_End: B := 1; { Key value = 1 }
- VK_Down: B := 2; { Key value = 2 }
- VK_Next: B := 3; { Key value = 3 }
- VK_Left: B := 4; { Key value = 4 }
- VK_Clear: B := 5; { Key value = 5 }
- VK_Right: B := 6; { Key value = 6 }
- VK_Home: B := 7; { Key value = 7 }
- VK_Up: B := 8; { Key value = 8 }
- VK_Prior: B := 9; { Key value = 9 }
- VK_NumPad0..VK_NumPad9: B := Msg.wParam
- - $60; { Numbic key pad }
- Else NumPos := 0; { Invalid key }
- End;
- If ((NumPos > 0) AND (NumPos < 4)) AND { Valid position }
- ((B >= $0) AND (B <= $9)) Then Begin { Valid key }
- Numeric := Numeric*10 + B; { Adjust numeric }
- Inc(NumPos); { Next position }
- If (NumPos = 4) Then Begin { We have three keys }
- Event.What := evKeyDown; { Set keydown event }
- Event.CharCode := Chr(Numeric); { Transfer code }
- NumPos := 0; { Zero number position }
- End;
- Handled := True; { Message was handled }
- End Else NumPos := 0; { Zero number position }
- End;
- If (Msg.WParam = vk_Menu) Then Begin { ALT key down }
- Numeric := 0; { Zero numeric }
- NumPos := 1; { Set to start point }
- Handled := True; { Message was handled }
- End;
- If NOT Handled Then Begin { Key press not handled }
- If (Lo(Msg.wParam) < 128) Then Begin { Ignore if above 128 }
- If (Msg.wParam = vk_F10) Then Begin { F10 reports oddly }
- If (GetKeyState(vk_Shift) AND $80 <> 0)
- Then Event.KeyCode := kbShiftF10 Else{ Shift F10 }
- If (GetKeyState(vk_Menu) AND $80 <> 0)
- Then Event.KeyCode := kbAltF10 Else { Alt F10 }
- If (GetKeyState(vk_Control) AND $80 <> 0)
- Then Event.KeyCode := kbCtrlF10 { Ctrl F10 }
- Else Event.KeyCode := kbF10; { Normal F10 }
- End Else Event.KeyCode :=
- AltVirtualToAscii[Lo(Msg.wParam)]; { Convert key code }
- End Else Event.KeyCode := 0; { Clear Event.keycode }
- If (Event.KeyCode <> 0) Then Begin { If valid key then }
- Event.What := evKeyDown; { Key down event }
- Handled := True; { Message was handled }
- End;
- End;
- End;
- WM_KeyDown: Begin { ARROWS/F1..F12 KEYS }
- If (((Msg.WParam >= Vk_F1) AND (Msg.WParam <= Vk_F12)) OR
- ((Msg.WParam >= Vk_Prior) AND (Msg.WParam <= Vk_Delete)))
- Then Begin { Special key press }
- Event.CharCode := #0; { Clear char code }
- Event.ScanCode := Lo(HiWord(Msg.LParam)); { Create scan code }
- If (GetKeyState(vk_Shift) AND $80 <> 0)
- Then Begin { Shift key down }
- Case Msg.wParam Of
- vk_F1..vk_F9: Event.KeyCode :=
- Event.KeyCode + $1900; { Shift F1..F9 keys }
- vk_F11: Event.KeyCode := kbShiftF11; { Shift F11 key }
- vk_F12: Event.KeyCode := kbShiftF12; { Shift F12 key }
- End;
- End Else If (GetKeyState(vk_Control) AND $80 <> 0)
- Then Begin { Control key down }
- Case Msg.wParam Of
- vk_F1..vk_F9: Event.KeyCode :=
- Event.KeyCode + $2300; { Ctrl F1..F9 keys }
- vk_F11: Event.KeyCode := kbCtrlF11; { Ctrl F11 key }
- vk_F12: Event.KeyCode := kbCtrlF12; { Ctrl F12 key }
- End;
- End;
- If (Event.KeyCode <> 0) Then Begin { If valid key then }
- Event.What := evKeyDown; { Key down event }
- Handled := True; { Message was handled }
- End;
- End;
- NumPos := 0; { Zero number position }
- End;
- End;
- If NOT Handled Then Begin { Check we did not handle }
- TranslateMessage(Msg); { Translate message }
- DispatchMessage(Msg); { Dispatch message }
- End;
- End;
-END;
-{$ENDIF}
-{$IFDEF OS_OS2} { OS2 CODE }
-VAR Msg: QMsg;
-BEGIN
- Event.What := evNothing; { Preset no event }
- If (WinPeekMsg(Anchor, Msg, 0, 0, WM_MouseFirst-1, pm_Remove)
- OR WinPeekMsg(Anchor, Msg, 0, WM_MouseLast+1, $FFFFFFFF, pm_Remove))
- Then Begin { Check for message }
- If (Msg.Msg = WM_Char) AND { Character message }
- (Msg.Mp1 AND KC_KeyUp <> 0) AND { Key released }
- (Msg.Mp1 AND KC_Composite = 0) { Not composite key }
- Then Begin
- If (Short1FromMP(Msg.Mp1) AND KC_ScanCode <> 0 )
- Then Begin
- Event.ScanCode := Ord(Char4FromMP(Msg.Mp1)); { Return scan code }
- Event.CharCode := Char1FromMP(Msg.Mp2); { Return char code }
- If (Event.CharCode = Chr($E0)) Then Begin
- Event.CharCode := #0;
- Event.ScanCode := Byte(Char2FromMP(Msg.Mp2));
- End;
- If (Event.KeyCode <> 0) Then
- Event.What := evKeyDown; { Key down event }
- End;
- End;
- If (Event.What = evNothing) Then { Event not handled }
- WinDispatchMsg(Anchor, Msg); { Disptach message }
- End;
-END;
-{$ENDIF}
-
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-{ MOUSE CONTROL ROUTINES }
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-
-{---------------------------------------------------------------------------}
-{ HideMouse -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jun98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE HideMouse;
-BEGIN
- If (HideCount = 0) Then Begin { Is mouse hidden yet? }
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
- HideMouseCursor; { Hide mouse cursor }
- {$ENDIF}
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- ShowCursor(False); { Hide mouse cursor }
- {$ENDIF}
- {$IFDEF OS_OS2} { OS2 CODE }
- If (AppWindow <> 0) Then { Window valid }
- WinShowCursor(AppWindow, False); { Hide mouse cursor }
- {$ENDIF}
- End;
- Inc(HideCount); { Inc hide count }
-END;
-
-{---------------------------------------------------------------------------}
-{ ShowMouse -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jun98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE ShowMouse;
-BEGIN
- Dec(HideCount); { Dec hide count }
- If (HideCount = 0) Then Begin { Is mouse visible? }
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
- ShowMouseCursor; { Show mouse cursor }
- {$ENDIF}
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- ShowCursor(True); { Show mouse cursor }
- {$ENDIF}
- {$IFDEF OS_OS2} { OS2 CODE }
- If (AppWindow <> 0) Then { Window valid }
- WinShowCursor(AppWindow, True); { Show mouse cursor }
- {$ENDIF}
- End;
-END;
-
-{---------------------------------------------------------------------------}
-{ GetMouseEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 09Sep98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE GetMouseEvent (Var Event: TEvent);
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
-ASSEMBLER;
- {$IFDEF ASM_BP} { BP COMPATABLE ASM }
-ASM
- CMP MouseEvents, 0; { Any mouse events }
- JNZ @@MouseOk; { Check mouse active }
- JMP @@NoEventExit; { Mouse not active }
-@@MouseOk:
- CLI; { Disable interrupts }
- CMP EventCount, 0; { Check event count }
- JNE @@MouseEventInQueue; { If > 0 event avail }
- MOV BL, MouseButtons; { Fetch mouse buttons }
- MOV CX, MouseWhere.Word[0]; { Fetch mouse where.x }
- MOV DX, MouseWhere.Word[2]; { Fetch mouse where.y }
- MOV ES, Seg0040; { DOS DAT SEG }
- MOV DI, ES:Ticks; { Fetch current time }
- JMP @@NextMsgReady; { Now process }
-@@MouseEventInQueue:
- MOV SI, WORD PTR EventQHead; { Event queue head }
- CLD; { Direction forward }
- LODSW; { Fetch word 1 }
- XCHG AX, DI; { Set timer ticks }
- LODSW; { Fetch word 2 }
- XCHG AX, BX; { Set button masks }
- LODSW; { Fetch word 3 }
- XCHG AX, CX; { Set mouse x position }
- LODSW; { Fetch word 4 }
- XCHG AX, DX; { Set mouse y position }
- CMP SI, OFFSET EventQLast; { Check if roll needed }
- JNE @@NoRoll;
- MOV SI, OFFSET EventQueue; { Roll back to start }
-@@NoRoll:
- MOV WORD PTR EventQHead, SI; { Update queue head }
- DEC EventCount; { One event cleared }
-@@NextMsgReady:
- STI; { Enable interrupts }
- CMP MouseReverse, 0; { Check mouse reversed }
- JE @@MouseNormal;
- MOV BH, BL; { Transfer button mask }
- AND BH, 3; { Clear others masks }
- JE @@MouseNormal; { Neither set exit }
- CMP BH, 3; { Check not all set }
- JE @@MouseNormal; { Both set exit }
- XOR BL, 3; { Invert button masks }
-@@MouseNormal:
- MOV BH, [LastDouble]; { Load last double }
- MOV AL, [LastButtons]; { Load last buttons }
- CMP AL, BL; { Are buttons same? }
- JE @@SameButtonsDown;
- OR AL, AL; { Any last buttons? }
- JE @@ButtonsDown;
- OR BL, BL; { Any buttons down? }
- JE @@MouseUp;
- MOV BL, AL; { Transfer new buttons }
-@@SameButtonsDown:
- CMP CX, [LastWhereX]; { Mouse moved from x }
- JNE @@MouseMove;
- CMP DX, [LastWhereY]; { Mouse moved from y }
- JNE @@MouseMove;
- OR BL, BL; { Any buttons pressed? }
- JE @@NoButtonsDown;
- MOV AX, DI; { Current tick count }
- SUB AX, [AutoTicks]; { Subtract last count }
- CMP AX, [AutoDelay]; { Greater than delay? }
- JAE @@MouseAuto; { Mouse auto event }
-@@NoButtonsDown:
- JMP @@NoEventExit; { No event exit }
-@@ButtonsDown:
- MOV BH, 0; { Preset no dbl click }
- CMP BL, [DownButtons]; { Check to last down }
- JNE @@MouseDown;
- CMP CX, [DownWhereX]; { Check x position }
- JNE @@MouseDown;
- CMP DX, [DownWhereY]; { Check y position }
- JNE @@MouseDown;
- MOV AX, DI; { Transfer tick count }
- SUB AX, [DownTicks]; { Sub last down count }
- CMP AX, [DoubleDelay]; { Greater than delay? }
- JAE @@MouseDown;
- MOV BH, 1; { Double click }
-@@MouseDown:
- MOV [DownButtons], BL; { Hold down buttons }
- MOV [DownWhereX], CX; { Hold x down point }
- MOV [DownWhereY], DX; { Hold y down point }
- MOV [DownTicks], DI; { Hold tick value }
- MOV [AutoTicks], DI; { Hold tick value }
- MOV AX, [RepeatDelay]; { Load delay count }
- MOV [AutoDelay], AX; { Set delay time }
- MOV AX, evMouseDown; { Mouse down event }
- JMP @@UpdateValues; { Update, svae & exit }
-@@MouseUp:
- MOV AX, evMouseUp; { Mouse button up }
- JMP @@UpdateValues; { Update, save & exit }
-@@MouseMove:
- MOV AX, evMouseMove; { Mouse has moved }
- JMP @@UpdateValues; { Update, save & exit }
-@@MouseAuto:
- MOV AX, evMouseAuto; { Mouse auto event }
- MOV [AutoTicks], DI; { Reset auto ticks }
- MOV [AutoDelay], 1; { Reset delay count }
-@@UpdateValues:
- MOV [LastButtons], BL; { Save last buttons }
- MOV [LastDouble], BH; { Save double state }
- MOV [LastWhereX], CX; { Save x position }
- MOV [LastWhereY], DX; { Save y position }
- JMP @@StoreAndExit; { Now store and exit }
-@@NoEventExit:
- XOR AX, AX; { Clear register }
- MOV BX, AX; { Clear register }
- MOV CX, AX; { Clear register }
- MOV DX, AX; { Clear register }
-@@StoreAndExit:
- LES DI, Event; { Address of event }
- CLD; { Set direction fwd }
- STOSW; { Save 1st word }
- XCHG AX, BX; { Transfer register }
- STOSW; { Save 2nd word }
- XCHG AX, CX; { Transfer register }
- STOSW; { Save 3rd word }
- XCHG AX, DX; { Transfer register }
- STOSW; { Save 4th word }
-END;
- {$ENDIF}
- {$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
-ASM
- CMPB $0, MOUSEEVENTS; { Any mouse events }
- JNZ .L_MouseOk; { Check mouse active }
- JMP .L_NoEventExit; { Mouse not active }
-.L_MouseOk:
- CLI;
- CMPW $0, EVENTCOUNT; { Check event count }
- JNE .L_MouseEventInQueue; { If > 0 event avail }
- MOVB MOUSEBUTTONS, %BL; { Fetch mouse buttons }
- MOVW MOUSEWHERE, %CX; { Fetch mouse where.x }
- MOVW MOUSEWHERE+2, %DX; { Fetch mouse where.y }
- PUSH %ES; { Save segment }
- MOVW $0x40, %AX; { Fetch DOS segment }
- MOVW %AX, %ES; { Transfer to segment }
- MOVL $0x6C, %EDI; { Tick address }
- MOVW %ES:(%EDI), %DI; { Fetch dos tick count }
- POP %ES; { Recover segment }
- JMP .L_NextMsgReady; { Now process }
-.L_MouseEventInQueue:
- MOVL EVENTQHEAD, %ESI; { Event queue head }
- CLD; { Direction forward }
- LODSW; { Fetch word 1 }
- XCHGW %DI, %AX; { Set timer ticks }
- LODSW; { Fetch word 2 }
- XCHGW %BX, %AX; { Set button masks }
- LODSW; { Fetch word 3 }
- XCHGW %CX, %AX; { Set mouse x position }
- LODSW; { Fetch word 4 }
- XCHGW %DX, %AX; { Set mouse y position }
- LEAL EVENTQLAST, %EAX; { Address of roll pt }
- CMPL %EAX, %ESI; { Check if roll needed }
- JNE .L_NoHeadRoll;
- LEAL EVENTQUEUE, %ESI; { Roll back to start }
-.L_NoHeadRoll:
- MOVL %ESI, EVENTQHEAD; { Update queue head }
- DECW EVENTCOUNT; { One event cleared }
-.L_NextMsgReady:
- STI; { Enable interrupts }
- CMPB $0, MOUSEREVERSE; { Check mouse reversed }
- JE .L_MouseNormal;
- MOVB %BL, %BH; { Transfer button mask }
- ANDB $3, %BH; { Clear others masks }
- JE .L_MouseNormal; { Neither set exit }
- CMPB $3, %BH; { Check not all set }
- JE .L_MouseNormal; { Both set exit }
- XORB $3, %BL; { Invert button masks }
-.L_MouseNormal:
- MOVB LASTDOUBLE, %BH; { Load last double }
- MOVB LASTBUTTONS, %AL; { Load last buttons }
- CMPB %BL, %AL; { Are buttons same? }
- JE .L_SameButtonsDown;
- ORB %AL, %AL; { Any last buttons? }
- JE .L_ButtonsDown;
- ORB %BL, %BL; { Any buttons down? }
- JE .L_MouseUp;
- MOVB %AL, %BL; { Transfer new buttons }
-.L_SameButtonsDown:
- CMPW LASTWHEREX, %CX; { Mouse moved from x }
- JNE .L_MouseMove;
- CMPW LASTWHEREY, %DX; { Mouse moved from y }
- JNE .L_MouseMove;
- ORB %BL, %BL; { Any buttons pressed? }
- JE .L_NoButtonsDown;
- MOVW %DI, %AX; { Current tick count }
- SUBW AUTOTICKS, %AX; { Subtract last count }
- CMPW AUTODELAY, %AX; { Greater than delay? }
- JAE .L_MouseAuto; { Mouse auto event }
-.L_NoButtonsDown:
- JMP .L_NoEventExit; { No event exit }
-.L_ButtonsDown:
- MOVB $0, %BH; { Preset no dbl click }
- CMPB DOWNBUTTONS, %BL; { Check to last down }
- JNE .L_MouseDown;
- CMPW DOWNWHEREX, %CX; { Check x position }
- JNE .L_MouseDown;
- CMPW DOWNWHEREY, %DX; { Check y position }
- JNE .L_MouseDown;
- MOVW %DI, %AX; { Transfer tick count }
- SUBW DOWNTICKS, %AX; { Sub last down count }
- CMPW DOUBLEDELAY, %AX; { Greater than delay? }
- JAE .L_MouseDown;
- MOVB $1, %BH; { Double click }
-.L_MouseDown:
- MOVB %BL, DOWNBUTTONS; { Hold down buttons }
- MOVW %CX, DOWNWHEREX; { Hold x down point }
- MOVW %DX, DOWNWHEREY; { Hold y down point }
- MOVW %DI, DOWNTICKS; { Hold tick value }
- MOVW %DI, AUTOTICKS; { Hold tick value }
- MOVW REPEATDELAY, %AX; { Load delay count }
- MOVW %AX, AUTODELAY; { Set delay time }
- MOVW $1, %AX; { Mouse down event }
- JMP .L_UpdateValues; { Update, svae & exit }
-.L_MouseUp:
- MOVW $2, %AX; { Mouse button up }
- JMP .L_UpdateValues; { Update, save & exit }
-.L_MouseMove:
- MOVW $4, %AX; { Mouse has moved }
- JMP .L_UpdateValues; { Update, save & exit }
-.L_MouseAuto:
- MOVW $8, %AX; { Mouse auto event }
- MOVW %DI, AUTOTICKS; { Reset auto ticks }
- MOVW $1, AUTODELAY; { Reset delay count }
-.L_UpdateValues:
- MOVB %BL, LASTBUTTONS; { Save last buttons }
- MOVB %BH, LASTDOUBLE; { Save double state }
- MOVW %CX, LASTWHEREX; { Save x position }
- MOVW %DX, LASTWHEREY; { Save y position }
- JMP .L_StoreAndExit; { Now store and exit }
-.L_NoEventExit:
- XORW %AX, %AX; { Clear register }
- MOVW %AX, %BX; { Clear register }
- MOVW %AX, %CX; { Clear register }
- MOVW %AX, %DX; { Clear register }
-.L_StoreAndExit:
- MOVL Event, %EDI; { Adress of event }
- CLD; { Set direction fwd }
- STOSW; { Save 1st word }
- XCHGW %BX, %AX; { Transfer register }
- STOSW; { Save 2nd word }
- XCHGW %CX, %AX; { Transfer register }
- STOSW; { Save 3rd word }
- XCHGW %DX, %AX; { Transfer register }
- STOSW; { Save 4th word }
-END;
-{$ENDIF}
-{$ENDIF}
-{$IFDEF OS_WINDOWS} { WIN/NT CODE }
-VAR Msg: TMsg;
-BEGIN
- Event.What := evNothing; { Preset no event }
- {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
- If PeekMessage(@Msg, 0, WM_MouseFirst,
- WM_MouseLast, pm_Remove) Then Begin { Fetch mouse message }
- {$ELSE} { OTHER COMPILERS }
- If PeekMessage(Msg, 0, WM_MouseFirst,
- WM_MouseLast, pm_Remove) Then Begin { Fetch mouse message }
- {$ENDIF}
- TranslateMessage(Msg); { Translate message }
- DispatchMessage(Msg); { Dispatch message }
- End;
-END;
-{$ENDIF}
-{$IFDEF OS_OS2} { OS2 CODE }
-VAR Msg: QMsg;
-BEGIN
- Event.What := evNothing; { Preset no event }
- If WinPeekMsg(Anchor, Msg, 0, WM_MouseFirst,
- WM_MouseLast, pm_Remove) Then Begin { Fetch mouse message }
- WinDispatchMsg(Anchor, Msg); { Dispatch message }
- End;
-END;
-{$ENDIF}
-{$endif not Use_API}
-
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ EVENT HANDLER CONTROL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -2463,7 +1172,6 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE InitEvents;
BEGIN
-{$ifdef Use_API}
If (ButtonCount <> 0) Then
begin { Mouse is available }
Mouse.InitMouse; { Hook the mouse }
@@ -2480,33 +1188,6 @@ BEGIN
LastWhereY:=MouseWhere.y;
MouseEvents := True; { Set initialized flag }
end;
-{$else not Use_API}
- If (ButtonCount <> 0) Then Begin { Mouse is available }
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
- EventQHead := @EventQueue; { Initialize head }
- EventQtail := @EventQueue; { Initialize tail }
- LastDouble := False; { Clear last double }
- LastButtons := 0; { Clear last buttons }
- DownButtons := 0; { Clear down buttons }
- HookMouse; { Hook the mouse }
- GetMousePosition(MouseWhere.X, MouseWhere.Y); { Get mouse position }
- LastWhereX := MouseWhere.X; { Set last x position }
- LastWhereY := MouseWhere.Y; { Set last y position }
- MouseEvents := True; { Set initialized flag }
- ShowMouseCursor; { Show the mouse }
- {$ENDIF}
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- MouseEvents := True; { Set initialized flag }
- {$ENDIF}
- {$IFDEF OS_OS2} { OS2 CODE }
- If (Anchor=0) Then Anchor := WinInitialize(0); { Create anchor block }
- If (MsgQue = 0) AND (Anchor <> 0) Then
- MsgQue := WinCreateMsgQueue(Anchor, 0); { Initialize queue }
- If (MsgQue = 0) Then Halt(254); { Check queue created }
- MouseEvents := True; { Set initialized flag }
- {$ENDIF}
- End;
-{$endif not Use_API}
END;
{---------------------------------------------------------------------------}
@@ -2514,60 +1195,11 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE DoneEvents;
BEGIN
-{$ifdef Use_API}
-{$else not Use_API}
- If MouseEvents Then Begin { Initialized check }
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
- HideMouseCursor; { Hide the mouse }
- MouseEvents := False; { Clear event flag }
- UnHookMouse; { Unhook the mouse }
- {$ENDIF}
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- MouseEvents := False; { Clr initialized flag }
- {$ENDIF}
- {$IFDEF OS_OS2} { OS2 CODE }
- If (MsgQue <> 0) Then WinDestroyMsgQueue(MsgQue);{ Destroy msg queue }
- If (Anchor <> 0) Then WinTerminate(Anchor); { Destroy anchor block }
- MsgQue := 0; { Zero msg queue handle }
- Anchor := 0; { Zero anchor block }
- MouseEvents := False; { Clr initialized flag }
- {$ENDIF}
- End;
-{$endif not Use_API}
END;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ VIDEO CONTROL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-{$ifndef Use_API}
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
-{$IFDEF PPC_FPC} { FPC COMPILER ONLY }
-{ ******************************* REMARK ****************************** }
-{ This is purely temporary for FPC because the Graph is SuperVGA you }
-{ have no mouse pointer on screen because the mouse drivers don't go }
-{ up to supporting SVGA modes. This simply makes a cross hair so you }
-{ can see the mouse for now..will be fixed soon. }
-{ ****************************** END REMARK *** Leon de Boer, 04Nov99 * }
-VAR LastX, LastY: Integer;
-
-PROCEDURE ShowTheMouse; FAR;
-BEGIN
- If (MouseEvents = True) AND (HideCount = 0) { Mouse visible }
- Then Begin
- SetWriteMode(XORPut); { XOR write mode }
- SetColor(15); { Set color to white }
- Line(LastX-5, LastY, LastX+5, LastY); { Remove horz line }
- Line(LastX, LastY-5, LastX, LastY+5); { Remove vert line }
- LastX := MouseWhere.X; { Update x position }
- LastY := MouseWHere.Y; { Update y position }
- Line(LastX-5, LastY, LastX+5, LastY); { Draw horz line }
- Line(LastX, LastY-5, LastX, LastY+5); { Draw vert line }
- SetWriteMode(NormalPut); { Write mode to normal }
- End;
-END;
-{$ENDIF}
-{$ENDIF}
-{$endif not Use_API}
{---------------------------------------------------------------------------}
{ InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB }
@@ -2580,64 +1212,12 @@ VAR {$ifdef Use_API}I, J: Integer;
{$IFDEF OS_OS2} Ts, Fs: Integer; Ps: HPs; Tm: FontMetrics; {$ENDIF}
{$ENDIF}
BEGIN
- {$ifdef Use_API}
- Video.InitVideo;
- ScreenWidth:=Video.ScreenWidth;
- ScreenHeight:=Video.ScreenHeight;
- GetVideoMode(ScreenMode);
- I := ScreenWidth*8 -1; { Mouse width }
- J := ScreenHeight*8 -1; { Mouse height }
- SysScreenWidth := I + 1;
- SysScreenHeight := J + 1;
- SysFontWidth := 8; { Font width }
- SysFontHeight := 8; { Font height }
- {$else not Use_API}
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
- If (TextModeGFV = True) Then Begin { TEXT MODE GFV }
- I := ScreenWidth*8 -1; { Mouse width }
- J := ScreenHeight*8 -1; { Mouse height }
- SysScreenWidth := I + 1;
- SysScreenHeight := J + 1;
- End Else Begin { GRAPHICS MODE GFV }
- I := Detect; { Detect video card }
- J := 0; { Zero select mode }
- InitGraph(I, J, ''); { Initialize graphics }
- I := GetMaxX; { Fetch max x size }
- J := GetMaxY; { Fetch max y size }
- End;
- {$IFDEF PPC_FPC} { FPC DOS COMPILER }
- ASM
- MOVW $7, %AX; { Set function id }
- MOVW $0, %CX; { Clear register }
- MOVW I, %DX; { Maximum x size }
- INT $0x33; { Set mouse x movement }
- MOVW $8, %AX; { Set function id }
- MOVW $0, %CX; { Clear register }
- MOVW J, %DX; { Maximum y size }
- INT $0x33; { Set mouse y movement }
- END;
- Lock_Code(Pointer(@ShowTheMouse), 400); { Lock cursor code }
- If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV }
- MouseMoveProc := ShowTheMouse; { Set move function }
- ShowMouseProc := ShowTheMouse; { Set show function }
- HideMouseProc := ShowTheMouse; { Set hide function }
- End;
- {$ELSE} { OTHER DOS COMPILERS }
- ASM
- MOV AX, 7; { Set function id }
- XOR CX, CX; { Clear register }
- MOV DX, I; { Maximum x size }
- INT 33H; { Set mouse x movement }
- MOV AX, 8; { Set function id }
- XOR CX, CX; { Clear register }
- MOV DX, J; { Maximum y size }
- INT 33H; { Set mouse y movement }
- END;
- {$ENDIF}
- If (TextModeGFV = True) Then Begin { TEXT MODE GFV }
- SysFontWidth := 8; { Font width }
- SysFontHeight := 8; { Font height }
- End Else Begin { GRAPHICS MODE GFV }
+{$ifdef GRAPH_API}
+ I := Detect; { Detect video card }
+ J := 0; { Zero select mode }
+ InitGraph(I, J, ''); { Initialize graphics }
+ I := GetMaxX; { Fetch max x size }
+ J := GetMaxY; { Fetch max y size }
If (DefFontHeight = 0) Then { Font height not set }
J := (GetMaxY+1) DIV DefLineNum { Approx font height }
Else J := DefFontHeight; { Use set font height }
@@ -2651,110 +1231,19 @@ BEGIN
SysFontWidth; { Calc screen width }
ScreenHeight := (SysScreenHeight+1) DIV
SysFontHeight; { Calc screen height }
- End;
- {$ENDIF}
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- SysScreenWidth := GetSystemMetrics(
- SM_CXFullScreen)-GetSystemMetrics(SM_CXFrame); { Max screen width }
- SysScreenHeight := GetSystemMetrics(
- SM_CYFullScreen); { Max screen height }
- SystemParametersInfo(SPI_GETICONTITLELOGFONT,
- SizeOf(TLogFont), @TempFont, 0); { Get system font }
- With TempFont Do Begin
- If (DefFontHeight = 0) Then Begin { Font height not set }
- lfHeight := SysScreenHeight DIV DefLineNum; { Best guess height }
- End Else lfHeight := -DefFontHeight; { Specific font height }
- lfWidth := 0; { No specific width }
- lfEscapement := 0; { No specifics }
- lfOrientation := 0; { Normal orientation }
- lfWeight := DefFontWeight; { Default font weight }
- lfItalic := 0; { No italics }
- lfUnderline := 0; { No underlines }
- lfStrikeOut := 0; { No strikeouts }
- lfCharSet := ANSI_CharSet; { ANSI font set }
- lfOutPrecision := Out_Default_Precis; { Default precision out }
- lfClipPrecision := Clip_Default_Precis; { Default clip precision }
- lfQuality := Proof_Quality; { Proof quality }
- lfPitchAndFamily:= Variable_Pitch OR
- Fixed_Pitch; { Either fitch format }
-(* {$IFDEF WESTERNS}
- FillChar(lfFaceName, SizeOf(lfFaceName), #0); { Clear memory area }
- Move(DefFontStyle[1], lfFacename,
- Length(DefFontStyle)); { Transfer style name }
- {$ELSE}
- DefFontStyle[0] := Chr(StrLen(lfFacename));
- Move(lfFacename, DefFontStyle[1], Ord(DefFontStyle[0]));
- {$ENDIF}*)
- End;
- {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
- DefGFVFont := CreateFontIndirect(@TempFont); { Create a default font }
- {$ELSE}
- DefGFVFont := CreateFontIndirect(TempFont); { Create a default font }
- {$ENDIF}
- Dc := GetDc(0); { Get screen context }
- Mem := CreateCompatibleDC(Dc); { Compatable context }
- SelectObject(Mem, DefGFVFont); { Select the font }
- {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
- GetTextMetrics(Mem, @Tm); { Get text metrics }
- {$ELSE} { OTHER COMPILERS }
- GetTextMetrics(Mem, Tm); { Get text metrics }
- {$ENDIF}
- SysFontWidth := Tm.tmaveCharWidth+1; { Ave char font width }
- SysFontHeight := Tm.tmHeight; { Ave char font height }
- DeleteDc(Mem); { Destroy context }
- ReleaseDc(0, Dc); { Release context }
- {$ENDIF}
- {$IFDEF OS_OS2} { OS2 CODE }
- Ts := WinQuerySysValue(HWND_Desktop,
- SV_CYTitleBar) + 2*WinQuerySysValue(HWND_Desktop,
- SV_CYSizeBorder); { Title size }
- Fs := 2*WinQuerySysValue(HWND_DeskTop,
- SV_CXSizeBorder); { Frame size }
- SysScreenWidth := WinQuerySysValue(HWND_Desktop,
- SV_CXFullScreen) - Fs; { Max screen width }
- SysScreenHeight := WinQuerySysValue(HWND_Desktop,
- SV_CYFullScreen) - Ts; { Max screen height }
- (*With DefGFVFont Do Begin
- usRecordLength := SizeOf(fAttrs); { Structure size }
- fsSelection := $20; { Uses default selection }
- lMatch := 0; { Does not force match }
- idRegistry := 0; { Uses default registry }
- usCodePage := 850; { Code-page 850 }
- If (DefFontHeight = 0) Then Begin { Font height not set }
- lMaxBaselineExt := SysScreenHeight DIV DefLineNum; { Best guess height }
- End Else lMaxBaselineExt := DefFontHeight; { Specific font height }
- lAveCharWidth := 0; { Req font default width }
- fsType := 0; { Uses default type }
- fsFontUse := fAttr_FontUse_Nomix; { Doesn't mix with graphics }
- FillChar(szFaceName, SizeOf(szFaceName), #0); { Clear memory area }
- Move(DefFontStyle[1], szFacename,
- Length(DefFontStyle)); { Transfer style name }
- End;*)
- Ps := WinGetPS(HWND_Desktop); { Get desktop PS }
- (*GpiCreateLogFont(Ps, Nil, 1, DefGFVFont);*) { Create the font }
- GpiQueryFontMetrics(Ps, SizeOf(Tm), Tm); { Get text metrics }
- SysFontWidth := Tm.lAveCharWidth+1; { Transfer font width }
- SysFontHeight := Tm.lMaxBaselineExt; { Transfer font height }
- WinReleasePS(Ps); { Release desktop PS }
- DefPointer := WinQuerySysPointer(HWND_DESKTOP,
- SPTR_ARROW, False); { Hold default pointer }
- {$ENDIF}
- {$IFNDEF OS_DOS} { WIN/NT/OS2 ONLY }
- ScreenWidth := SysScreenWidth DIV SysFontWidth; { Calc screen width }
- ScreenHeight := SysScreenHeight DIV SysFontHeight;{ Calc screen height }
- SysScreenWidth := ScreenWidth * SysFontWidth; { Actual width }
- SysScreenHeight := ScreenHeight * SysFontHeight; { Actual height }
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- Inc(SysScreenWidth, 2*GetSystemMetrics(SM_CXFrame));{ Max screen width }
- Inc(SysScreenHeight, GetSystemMetrics(SM_CYCaption)
- + GetSystemMetrics(SM_CYFrame)); { Max screen height }
- {$ENDIF}
- {$IFDEF OS_OS2} { OS2 CODE }
- Inc(SysScreenWidth, Fs); { Max screen width }
- Inc(SysScreenHeight, Ts); { Max screen height }
- {$ENDIF}
- {$ENDIF}
- {$endif not Use_API}
+{$else not GRAPH_API}
+ Video.InitVideo;
+ ScreenWidth:=Video.ScreenWidth;
+ ScreenHeight:=Video.ScreenHeight;
+ SetViewPort(0,0,ScreenWidth,ScreenHeight,true,true);
+ GetVideoMode(ScreenMode);
+ I := ScreenWidth*8 -1; { Mouse width }
+ J := ScreenHeight*8 -1; { Mouse height }
+ SysScreenWidth := I + 1;
+ SysScreenHeight := J + 1;
+ SysFontWidth := 8; { Font width }
+ SysFontHeight := 8; { Font height }
+{$endif not GRAPH_API}
END;
{---------------------------------------------------------------------------}
@@ -2762,39 +1251,10 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE DoneVideo;
BEGIN
- {$ifdef Use_API}
- Video.DoneVideo;
+ {$ifdef GRAPH_API}
+ CloseGraph;
{$else not Use_API}
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
- {$IFDEF PPC_FPC}
- MouseMoveProc := Nil; { Clr mouse move ptr }
- ShowMouseProc := Nil; { Clr show mouse ptr }
- HideMouseProc := Nil; { Clr hide mouse ptr }
- UnLock_Code(Pointer(@ShowTheMouse), 400); { Unlock cursor code }
- {$ENDIF}
- If (TextModeGFV <> True) Then CloseGraph { Close down graphics }
- Else Begin { Text mode gfv }
- {$IFDEF PPC_FPC} { FPC DOS COMPILER }
- ASM
- MOVW SCREENMODE, %AX; { Original screen mode }
- PUSH %EBP; { Save register }
- INT $0x10; { Reset video }
- POP %EBP; { Restore register }
- END;
- {$ELSE} { OTHER DOS COMPILERS }
- ASM
- MOV AX, ScreenMode; { Original screen mode }
- PUSH BP; { Save register }
- INT 10H; { Reset video }
- POP BP; { Restore register }
- END;
- {$ENDIF}
- End;
- {$ENDIF}
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- If (DefGFVFont <> 0) Then { Check font created }
- DeleteObject(DefGFVFont); { Delete the font }
- {$ENDIF}
+ Video.DoneVideo;
{$endif not Use_API}
END;
@@ -2803,9 +1263,9 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE ClearScreen;
BEGIN
- {$ifdef Use_API}
+ {$ifndef GRAPH_API}
Video.ClearScreen;
- {$endif Use_API}
+ {$endif GRAPH_API}
END;
{---------------------------------------------------------------------------}
@@ -2855,29 +1315,8 @@ END;
{ PrintStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 18Feb99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE PrintStr (CONST S: String);
-{$IFDEF OS_WINDOWS} VAR Ts: String; {$ENDIF}
-{$IFDEF OS_OS2} VAR Ts: String; {$ENDIF}
BEGIN
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
Write(S); { Write to screen }
- {$ENDIF}
- {$IFDEF OS_LINUX} { LINIX CODE }
- Write(S); { Write to screen }
- {$ENDIF}
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- Ts := S + #0; { Make asciiz }
- {$IFNDEF PPC_SPEED} { NON SPEED COMPILER }
- MessageBox(0, @Ts[1], Nil, mb_Ok OR mb_IconStop);{ Display to screen }
- {$ELSE} { SYBIL 2+ COMPILER }
- MessageBox(0, CString(@Ts[1]), Nil, mb_Ok OR
- mb_IconStop); { Display to screen }
- {$ENDIF}
- {$ENDIF}
- {$IFDEF OS_OS2} { OS2 CODE }
- Ts := S + #0; { Make asciiz }
- WinMessageBox(0, 0, @Ts[1], Nil, mb_Ok OR
- 0, mb_IconHand); { Display to screen }
- {$ENDIF}
END;
{---------------------------------------------------------------------------}
@@ -2983,11 +1422,7 @@ BEGIN
ResultLength := 0; { Zero result length }
FormatIndex := 1; { Format index to 1 }
HandleParameter(0); { Handle parameter }
- {$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
SetLength(Result, ResultLength); { Set string length }
- {$ELSE} { OTHER COMPILERS }
- Result[0] := Chr(ResultLength); { Set string length }
- {$ENDIF}
END;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -3027,19 +1462,22 @@ END;
BEGIN
ButtonCount := DetectMouse; { Detect mouse }
DetectVideo; { Detect video }
- {$ifdef Use_API}
+ { text mode is the default mode }
TextModeGFV:=True;
InitKeyboard;
- {$endif Use_API}
{$ifdef Graph_API}
TextModeGFV:=false;
{$endif Graph_API}
+
SaveExit := ExitProc; { Save old exit }
ExitProc := @ExitDrivers; { Set new exit }
END.
{
$Log$
- Revision 1.9 2001-05-07 22:22:03 pierre
+ Revision 1.10 2001-05-10 16:46:27 pierre
+ + some improovements made
+
+ Revision 1.9 2001/05/07 22:22:03 pierre
* removed NO_WINDOW cond, added GRAPH_API
Revision 1.8 2001/05/04 15:43:45 pierre
@@ -3062,6 +1500,29 @@ END.
Revision 1.2 2000/08/24 12:00:21 marco
* CVS log and ID tags
-
-
}
+{******************[ REVISION HISTORY ]********************}
+{ Version Date Fix }
+{ ------- --------- --------------------------------- }
+{ 1.00 26 Jul 96 First DOS/DPMI platform release }
+{ 1.10 18 Nov 97 Windows conversion added. }
+{ 1.20 29 Aug 97 Platform.inc sort added. }
+{ 1.30 10 Jun 98 Virtual pascal 2.0 code added. }
+{ 1.40 13 Jul 98 Added FormatStr by Marco Schmidt. }
+{ 1.50 14 Jul 98 Fixed width = 0 in FormatStr. }
+{ 1.60 13 Aug 98 Complete rewrite of FormatStr. }
+{ 1.70 10 Sep 98 Added mouse int hook for FPC. }
+{ 1.80 10 Sep 98 Checks run & commenting added. }
+{ 1.90 15 Oct 98 Fixed for FPC version 0.998 }
+{ 1.91 18 Feb 99 Added PrintStr functions }
+{ 1.92 18 Feb 99 FormatStr literal '%' fix added }
+{ 1.93 10 Jul 99 Sybil 2.0 code added }
+{ 1.94 15 Jul 99 Fixed for FPC 0.9912 release }
+{ 1.95 26 Jul 99 Windows..Scales to GFV system font }
+{ 1.96 30 Jul 99 Fixed Ctrl+F1..F10 in GetKeyEvent }
+{ 1.97 07 Sep 99 InitEvent, DoneEvent fixed for OS2 }
+{ 1.98 09 Sep 99 GetMouseEvent fixed for OS2. }
+{ 1.99 03 Nov 99 FPC windows support added. }
+{ 2.00 26 Nov 99 Graphics stuff moved to GFVGraph }
+{ 2.01 21 May 00 DOS fixed to use std GRAPH unit }
+{**********************************************************}
diff --git a/fv/gfvgraph.pas b/fv/gfvgraph.pas
index 020441cfd8..956054acce 100644
--- a/fv/gfvgraph.pas
+++ b/fv/gfvgraph.pas
@@ -293,25 +293,28 @@ END;
PROCEDURE SetViewPort (X1, Y1, X2, Y2: Integer; Clip, TextMode: Boolean);
BEGIN
{$IFDEF GRAPH_API}
- If TextMode Then Begin { TEXT MODE GFV }
+ If TextMode Then Begin { TEXT MODE GFV }
{$ENDIF GRAPH_API}
If (X1 < 0) Then X1 := 0; { X1 negative fix }
- If (X1 > SysScreenWidth) Then
- X1 := SysScreenWidth; { X1 off screen fix }
+ If (X1 >SysScreenWidth) Then
+ X1 := SysScreenWidth; { X1 off screen fix }
If (Y1 < 0) Then Y1 := 0; { Y1 negative fix }
If (Y1 > SysScreenHeight) Then
- Y1 := SysScreenHeight; { Y1 off screen fix }
+ Y1 := SysScreenHeight; { Y1 off screen fix }
If (X2 < 0) Then X2 := 0; { X2 negative fix }
If (X2 > SysScreenWidth) Then
- X2 := SysScreenWidth; { X2 off screen fix }
+ X2 := SysScreenWidth; { X2 off screen fix }
If (Y2 < 0) Then Y2 := 0; { Y2 negative fix }
If (Y2 > SysScreenHeight) Then
- Y2 := SysScreenHeight; { Y2 off screen fix }
+ Y2 := SysScreenHeight; { Y2 off screen fix }
ViewPort.X1 := X1; { Set X1 port value }
ViewPort.Y1 := Y1; { Set Y1 port value }
ViewPort.X2 := X2; { Set X2 port value }
ViewPort.Y2 := Y2; { Set Y2 port value }
ViewPort.Clip := Clip; { Set port clip value }
+{$ifdef DEBUG}
+ Writeln(stderr,'New ViewPort(',X1,',',Y1,',',X2,',',Y2,')');
+{$endif DEBUG}
Cxp := X1; { Set current x pos }
Cyp := Y1; { Set current y pos }
{$IFDEF GRAPH_API}
@@ -333,7 +336,7 @@ BEGIN
{$IFDEF GRAPH_API}
If TextMode Then
{$ENDIF GRAPH_API}
- GetMaxX := SysScreenWidth-1 { Screen width }
+ GetMaxX := SysScreenWidth-1 { Screen width }
{$IFDEF GRAPH_API}
Else GetMaxX := Graph.GetMaxX; { Call graph func }
{$ENDIF GRAPH_API}
@@ -398,7 +401,10 @@ END;
END.
{
$Log$
- Revision 1.7 2001-05-07 23:36:35 pierre
+ Revision 1.8 2001-05-10 16:46:28 pierre
+ + some improovements made
+
+ Revision 1.7 2001/05/07 23:36:35 pierre
NO_WINDOW cond removed
Revision 1.6 2001/05/07 22:22:03 pierre
diff --git a/fv/views.pas b/fv/views.pas
index f6fda12453..8c4dc3f40e 100644
--- a/fv/views.pas
+++ b/fv/views.pas
@@ -57,17 +57,6 @@ UNIT Views;
{==== Compiler directives ===========================================}
-{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
- {$F+} { Force far calls - Used because of the FirstThat, ForNext ... }
- {$A+} { Word Align Data }
- {$B-} { Allow short circuit boolean evaluations }
- {$O+} { This unit may be overlaid }
- {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
- {$P-} { Normal string variables }
- {$N-} { No 80x87 code generation }
- {$E+} { Emulation is on }
-{$ENDIF}
-
{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
{$S-} { Disable Stack Checking }
@@ -164,6 +153,7 @@ CONST
goTabSelect = $0008; { Tab selectable }
goEveryKey = $0020; { Report every key }
goEndModal = $0040; { End modal }
+ goNoShadow = $0080; { Do not write shadows }
goGraphView = $1000; { Raw graphic view }
goGraphical = $2000; { Graphical view }
@@ -297,15 +287,6 @@ CONST
wnNoNumber = 0; { Window has no num }
MaxViewWidth = 132; { Max view width }
-{$IFDEF OS_WINDOWS} { WIN/NT CODE }
-
-{---------------------------------------------------------------------------}
-{ WIN32/NT LABEL CONSTANTS FOR WINDOW PROPERTY CALLS }
-{---------------------------------------------------------------------------}
-CONST
- ViewPtr = 'TVWINPTR'+#0; { View ptr label }
-
-{$ENDIF}
{***************************************************************************}
{ PUBLIC TYPE DEFINITIONS }
@@ -420,6 +401,7 @@ TYPE
PROCEDURE DrawFocus; Virtual;
PROCEDURE DrawCursor; Virtual;
PROCEDURE DrawBorder; Virtual;
+ PROCEDURE DrawShadow; Virtual;
PROCEDURE HideCursor;
PROCEDURE ShowCursor;
PROCEDURE BlockCursor;
@@ -480,7 +462,8 @@ TYPE
Count: Integer);
PROCEDURE DragView (Event: TEvent; Mode: Byte; Var Limits: TRect;
MinSize, MaxSize: TPoint);
-
+ PROCEDURE WriteAbs(X, Y, L :Integer;var Buf);
+ PROCEDURE WriteShadow(X1, Y1, X2, Y2 : Integer);
FUNCTION FontWidth: Integer;
FUNCTION Fontheight: Integer;
@@ -725,37 +708,6 @@ FUNCTION CreateIdScrollBar (X, Y, Size, Id: Integer; Horz: Boolean): PScrollBar;
{ INITIALIZED PUBLIC VARIABLES }
{***************************************************************************}
-{$IFDEF OS_WINDOWS} { WIN/NT CODE }
-
-TYPE TColorRef = LongInt; { TColorRef defined }
-
-{---------------------------------------------------------------------------}
-{ INITIALIZED WIN/NT VARIABLES }
-{---------------------------------------------------------------------------}
-CONST
- ColRef: Array [0..15] Of TColorRef = { Standard colour refs }
- (rgb_Black, rgb_Blue, rgb_Green, rgb_Cyan,
- rgb_Red, rgb_Magenta, rgb_Brown, rgb_LightGray,
- rgb_DarkGray, rgb_LightBlue, rgb_LightGreen,
- rgb_LightCyan, rgb_LightRed, rgb_LightMagenta,
- rgb_Yellow, rgb_White);
- ColBrush: Array [0..15] Of HBrush =
- (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
- ColPen: Array [0..15] Of HPen =
- (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
-{$ENDIF}
-
-{$IFDEF OS_OS2} { OS2 CODE }
-{---------------------------------------------------------------------------}
-{ INITIALIZED OS2 VARIABLES }
-{---------------------------------------------------------------------------}
-CONST
- ColRef: Array [0..15] Of LongInt =
- (clr_Black, clr_DarkBlue, clr_DarkGreen, clr_DarkCyan,
- clr_DarkRed, clr_DarkPink, clr_Brown, clr_PaleGray,
- clr_DarkGray, clr_Blue, clr_Green, clr_Cyan,
- clr_Red, clr_Pink, clr_Yellow, clr_White);
-{$ENDIF}
{---------------------------------------------------------------------------}
{ INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES }
@@ -1201,10 +1153,17 @@ END;
FUNCTION TView.OverlapsArea (X1, Y1, X2, Y2: Integer): Boolean;
BEGIN
OverLapsArea := False; { Preset false }
- If (RawOrigin.X > X2) Then Exit; { Area to the left }
- If ((RawOrigin.X + RawSize.X) < X1) Then Exit; { Area to the right }
- If (RawOrigin.Y > Y2) Then Exit; { Area is above }
- If ((RawOrigin.Y + RawSize.Y) < Y1) Then Exit; { Area is below }
+ If TextModeGFV then Begin
+ If (Origin.X > X2) Then Exit; { Area to the left }
+ If ((Origin.X + Size.X) < X1) Then Exit; { Area to the right }
+ If (Origin.Y > Y2) Then Exit; { Area is above }
+ If ((Origin.Y + Size.Y) < Y1) Then Exit; { Area is below }
+ End Else Begin
+ If (RawOrigin.X > X2) Then Exit; { Area to the left }
+ If ((RawOrigin.X + RawSize.X) < X1) Then Exit; { Area to the right }
+ If (RawOrigin.Y > Y2) Then Exit; { Area is above }
+ If ((RawOrigin.Y + RawSize.Y) < Y1) Then Exit; { Area is below }
+ End;
OverLapsArea := True; { Return true }
END;
@@ -1267,7 +1226,14 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE TView.DrawView;
VAR ViewPort: ViewPortType; { Common variables }
+ Parent : PGroup;
BEGIN
+ Parent:=Owner;
+ While Assigned(Parent) do Begin
+ If (Parent^.LockFlag>0) then
+ exit;
+ Parent:=Parent^.Owner;
+ End;
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfExposed <> 0) AND { View is exposed }
(State AND sfIconised = 0) Then Begin { View not iconised }
@@ -1277,6 +1243,7 @@ BEGIN
ViewPort.X2, ViewPort.Y2) Then Begin { Must be in area }
HideMouseCursor; { Hide mouse cursor }
If (DrawMask = 0) OR (DrawMask = vdNoChild) { No special masks set }
+ { OR Assigned(LimitsLocked) }
Then Begin { Treat as a full redraw }
DrawBackGround; { Draw background }
Draw; { Draw interior }
@@ -1287,18 +1254,36 @@ BEGIN
If (Options AND ofFramed <> 0) OR
(GOptions AND goThickFramed <> 0) { View has border }
Then DrawBorder; { Draw border }
+ If ((State AND sfShadow) <> 0) AND
+ (GOptions And goNoShadow = 0) Then
+ DrawShadow;
End Else Begin { Masked draws only }
If (DrawMask AND vdBackGnd <> 0) Then { Chk background mask }
- DrawBackGround; { Draw background }
+ Begin
+ DrawMask := DrawMask and Not vdBackGnd;
+ DrawBackGround; { Draw background }
+ end;
If (DrawMask AND vdInner <> 0) Then { Check Inner mask }
- Draw; { Draw interior }
+ Begin
+ DrawMask := DrawMask and Not vdInner;
+ Draw; { Draw interior }
+ End;
If (DrawMask AND vdFocus <> 0)
- AND (GOptions AND goDrawFocus <> 0)
- Then DrawFocus; { Check focus mask }
+ AND (GOptions AND goDrawFocus <> 0) then
+ Begin
+ DrawMask := DrawMask and Not vdFocus;
+ DrawFocus; { Check focus mask }
+ End;
If (DrawMask AND vdCursor <> 0) Then { Check cursor mask }
- DrawCursor; { Draw any cursor }
+ Begin
+ DrawMask := DrawMask and Not vdCursor;
+ DrawCursor; { Draw any cursor }
+ End;
If (DrawMask AND vdBorder <> 0) Then { Check border mask }
- DrawBorder; { Draw border }
+ Begin
+ DrawMask := DrawMask and Not vdBorder;
+ DrawBorder; { Draw border }
+ End;
End;
ShowMouseCursor; { Show mouse cursor }
End;
@@ -1342,6 +1327,8 @@ VAR I : sw_integer;
VerticalBar,
LeftLowCorner,
RightLowCorner : Char;
+ Color : Byte;
+ Focused : Boolean;
BEGIN
If (TextModeGFV = FALSE) Then Begin { GRAPHICS GFV MODE }
BiColorRectangle(0, 0, RawSize.X, RawSize.Y,
@@ -1355,7 +1342,10 @@ BEGIN
White, DarkGray, True); { Draw highlights }
End;
End Else Begin { TEXT GFV MODE }
- If not Focus or (GOptions AND goThickFramed = 0) then
+ Focused:=(State AND (sfSelected + sfModal)<>0);
+ if Assigned(Owner) then
+ Focused := Focused AND (@Self = Owner^.First);
+ If not Focused or (GOptions AND goThickFramed = 0) then
begin
LeftUpCorner:='�';
RightUpCorner:='�';
@@ -1373,20 +1363,49 @@ BEGIN
LeftLowCorner:='�';
RightLowCorner:='�';
end;
- WriteChar(0,0,LeftUpCorner,1,1);
- WriteChar(1,0,HorizontalBar,1,Size.X-2);
- WriteChar(Size.X-1,0,RightUpcorner,1,1);
+ if Focused then
+ Color := 2
+ else
+ Color := 1;
+ WriteChar(0,0,LeftUpCorner,Color,1);
+ WriteChar(1,0,HorizontalBar,Color,Size.X-2);
+ WriteChar(Size.X-1,0,RightUpcorner,Color,1);
For i:=1 to Size.Y -1 do
begin
- WriteChar(0,i,VerticalBar,1,1);
- WriteChar(Size.X-1,i,VerticalBar,1,1);
+ WriteChar(0,i,VerticalBar,Color,1);
+ WriteChar(Size.X-1,i,VerticalBar,Color,1);
end;
- WriteChar(0,Size.Y-1,LeftLowCorner,1,1);
- WriteChar(1,Size.Y-1,HorizontalBar,1,Size.X-2);
- WriteChar(Size.X-1,Size.Y-1,RightLowCorner,1,1);
+ WriteChar(0,Size.Y-1,LeftLowCorner,Color,1);
+ WriteChar(1,Size.Y-1,HorizontalBar,Color,Size.X-2);
+ WriteChar(Size.X-1,Size.Y-1,RightLowCorner,Color,1);
End;
END;
+PROCEDURE TView.DrawShadow;
+VAR X1, Y1, X2, Y2 : Integer;
+BEGIN
+ If not TextModeGFV then
+ exit;
+ If Assigned(Owner) Then Begin
+ X1:=RawOrigin.X+RawSize.X+1;
+ X2:=X1+ShadowSize.X*SysFontWidth;
+ Y1:=RawOrigin.Y+SysFontHeight;
+ Y2:=RawOrigin.Y+RawSize.Y+1+ShadowSize.Y*SysFontHeight;
+ GOptions := GOptions OR goNoShadow;
+ Owner^.RedrawArea(X1,Y1,X2,Y2);
+ WriteShadow(X1 div SysFontWidth, Y1 div SysFontHeight,
+ X2 div SysFontWidth, Y2 div SysFontHeight);
+ X1:=RawOrigin.X+SysFontWidth;
+ X2:=RawOrigin.X+RawSize.X+1;
+ Y1:=RawOrigin.Y+RawSize.Y+1;
+ Y2:=RawOrigin.Y+RawSize.Y+1+ShadowSize.Y*SysFontHeight;
+ Owner^.RedrawArea(X1,Y1,X2,Y2);
+ WriteShadow(X1 div SysFontWidth, Y1 div SysFontHeight,
+ X2 div SysFontWidth, Y2 div SysFontHeight);
+ GOptions := GOptions AND not goNoShadow;
+ End;
+END;
+
{--TView--------------------------------------------------------------------}
{ HideCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
{---------------------------------------------------------------------------}
@@ -1462,6 +1481,13 @@ BEGIN
Then Y2 := P^.RawOrigin.Y + P^.RawSize.Y; { Y maximum contain }
P := P^.Owner; { Move to owners owner }
End;
+ If TextModeGFV then Begin
+ X1 := X1 div SysFontWidth;
+ X2 := (X2 +SysFontWidth - 1) div SysFontWidth;
+ Y1 := Y1 div SysFontHeight;
+ Y2 := (Y2 +SysFontHeight -1) div SysFontHeight;
+ End;
+
If (LimitsLocked <> Nil) Then Begin { Locked = area redraw }
If (X2 < ViewPort.X1) Then Exit; { View left of locked }
If (X1 > ViewPort.X2) Then Exit; { View right of locked }
@@ -1482,38 +1508,48 @@ END;
PROCEDURE TView.DrawBackGround;
VAR Bc: Byte; X1, Y1, X2, Y2: Integer; ViewPort: ViewPortType;
X, Y: Integer;
+ Buf : TDrawBuffer;
BEGIN
If (GOptions AND goNoDrawView = 0) Then Begin { Non draw views exit }
If (State AND sfDisabled = 0) Then
Bc := GetColor(1) AND $F0 SHR 4 Else { Select back colour }
Bc := GetColor(4) AND $F0 SHR 4; { Disabled back colour }
GetViewSettings(ViewPort, TextModeGFV); { Get view settings }
- If (ViewPort.X1 <= RawOrigin.X) Then X1 := 0 { Right to left edge }
- Else X1 := ViewPort.X1-RawOrigin.X; { Offset from left }
- If (ViewPort.Y1 <= RawOrigin.Y) Then Y1 := 0 { Right to top edge }
- Else Y1 := ViewPort.Y1-RawOrigin.Y; { Offset from top }
- If (ViewPort.X2 >= RawOrigin.X+RawSize.X) Then
- X2 := RawSize.X Else { Right to right edge }
- X2 := ViewPort.X2-RawOrigin.X; { Offset from right }
- If (ViewPort.Y2 >= RawOrigin.Y+RawSize.Y) Then
- Y2 := RawSize.Y Else { Right to bottom edge }
- Y2 := ViewPort.Y2-RawOrigin.Y; { Offset from bottom }
- If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV }
- SetFillStyle(SolidFill, Bc); { Set fill colour }
- Bar(0, 0, X2-X1, Y2-Y1); { Clear the area }
- End Else Begin { TEXT MODE GFV }
- X1 := (RawOrigin.X+X1) DIV SysFontWidth;
- Y1 := (RawOrigin.Y+Y1) DIV SysFontHeight;
- X2 := (RawOrigin.X+X2) DIV SysFontWidth;
- Y2 := (RawOrigin.Y+Y2) DIV SysFontHeight;
+ If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV }
+ If (ViewPort.X1 <= RawOrigin.X) Then X1 := 0 { Right to left edge }
+ Else X1 := ViewPort.X1-RawOrigin.X; { Offset from left }
+ If (ViewPort.Y1 <= RawOrigin.Y) Then Y1 := 0 { Right to top edge }
+ Else Y1 := ViewPort.Y1-RawOrigin.Y; { Offset from top }
+ If (ViewPort.X2 >= RawOrigin.X+RawSize.X) Then
+ X2 := RawSize.X Else { Right to right edge }
+ X2 := ViewPort.X2-RawOrigin.X; { Offset from right }
+ If (ViewPort.Y2 >= RawOrigin.Y+RawSize.Y) Then
+ Y2 := RawSize.Y Else { Right to bottom edge }
+ Y2 := ViewPort.Y2-RawOrigin.Y; { Offset from bottom }
+ SetFillStyle(SolidFill, Bc); { Set fill colour }
+ Bar(0, 0, X2-X1, Y2-Y1); { Clear the area }
+ End Else Begin { TEXT MODE GFV }
+ If (ViewPort.X1 <= Origin.X) Then
+ X1 := Origin.X { Right to left edge }
+ Else X1 := ViewPort.X1; { Offset from left }
+ If (ViewPort.Y1 <= Origin.Y) Then
+ Y1 := Origin.Y { Right to top edge }
+ Else Y1 := ViewPort.Y1; { Offset from top }
+ If (ViewPort.X2 >= Origin.X+Size.X) Then
+ X2 := Origin.X + Size.X Else { Right to right edge }
+ X2 := ViewPort.X2; { Offset from right }
+ If (ViewPort.Y2 >= Origin.Y+Size.Y) Then
+ Y2 := Origin.Y + Size.Y Else { Right to bottom edge }
+ Y2 := ViewPort.Y2; { Offset from bottom }
If (State AND sfDisabled = 0) Then
Bc := GetColor(1) Else { Select back colour }
Bc := GetColor(4); { Disabled back colour }
- For Y := Y1 To Y2 Do
- For X := X1 To X2 Do Begin
- { FIXME: we shouldn't write direct here }
- VideoBuf^[(Y*Drivers.ScreenWidth+X)] := (Bc shl 8) or $20;
- End;
+ For X := X1 To X2 Do Begin
+ Buf[X-X1]:=(Bc shl 8) or $20;
+ End;
+ For Y := Y1 To Y2 Do Begin
+ WriteAbs(X1,Y, X2-X1, Buf);
+ End;
{ FIXME: we shouldn't update always here }
UpdateScreen(false);
End;
@@ -1560,6 +1596,8 @@ END;
{ SetDrawMask -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.SetDrawMask (Mask: Byte);
+VAR
+ OldMask : byte;
BEGIN
If (Options AND ofFramed = 0) AND { Check for no frame }
(GOptions AND goThickFramed = 0) AND { Check no thick frame }
@@ -1569,7 +1607,20 @@ BEGIN
Mask := Mask AND NOT vdCursor; { Clear cursor draw }
If (GOptions AND goDrawFocus = 0) Then { Check no focus draw }
Mask := Mask AND NOT vdFocus; { Clear focus draws }
+ OldMask:=DrawMask;
DrawMask := DrawMask OR Mask; { Set draw masks }
+ (*If TextModeGFV and (DrawMask<>0) and (DrawMask<>OldMask) then Begin
+ Mask:=vdBackGnd OR vdInner OR vdBorder OR vdCursor OR vdFocus;
+ If (Options AND ofFramed = 0) AND { Check for no frame }
+ (GOptions AND goThickFramed = 0) AND { Check no thick frame }
+ (GOptions AND goTitled = 0) Then { Check for title }
+ Mask := Mask AND NOT vdBorder; { Clear border draw }
+ If (State AND sfCursorVis = 0) Then { Check for no cursor }
+ Mask := Mask AND NOT vdCursor; { Clear cursor draw }
+ If (GOptions AND goDrawFocus = 0) Then { Check no focus draw }
+ Mask := Mask AND NOT vdFocus; { Clear focus draws }
+ DrawMask := DrawMask OR Mask; { Set draw masks }
+ End; *)
END;
{--TView--------------------------------------------------------------------}
@@ -1620,12 +1671,14 @@ BEGIN
If (Owner <> Nil) Then Owner^.ReDrawArea(
RawOrigin.X, RawOrigin.Y, RawOrigin.X +
RawSize.X, RawOrigin.Y + RawSize.Y); { Redraw old area }
+ Owner^.Lock;
Owner^.RemoveView(@Self); { Remove from list }
Owner^.InsertView(@Self, Target); { Insert into list }
State := State OR sfVisible; { Allow drawing again }
If (LastView <> Target) Then DrawView; { Draw the view now }
If (Options AND ofSelectable <> 0) Then { View is selectable }
If (Owner <> Nil) Then Owner^.ResetCurrent; { Reset current }
+ Owner^.Unlock;
End;
END;
@@ -1662,6 +1715,12 @@ PROCEDURE TView.ReDrawArea (X1, Y1, X2, Y2: Integer);
VAR HLimit: PView; ViewPort: ViewPortType;
BEGIN
GetViewSettings(ViewPort, TextModeGFV); { Hold view port }
+ If TextModeGFV then Begin
+ X1 := X1 div SysFontWidth;
+ X2 := (X2 +SysFontWidth - 1) div SysFontWidth;
+ Y1 := Y1 div SysFontHeight;
+ Y2 := (Y2 +SysFontHeight -1) div SysFontHeight;
+ End;
SetViewPort(X1, Y1, X2, Y2, ClipOn, TextModeGFV); { Set new clip limits }
HLimit := LimitsLocked; { Hold lock limits }
LimitsLocked := @Self; { We are the lock view }
@@ -1695,10 +1754,13 @@ END;
{ SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.SetState (AState: Word; Enable: Boolean);
-VAR Command: Word;
+VAR OldState, Command: Word;
+ ShouldDraw : Boolean;
BEGIN
+ OldState := State;
If Enable Then State := State OR AState { Set state mask }
Else State := State AND NOT AState; { Clear state mask }
+ ShouldDraw:=false;
If (AState AND sfVisible <> 0) Then Begin { Visibilty change }
If (Owner <> Nil) AND { valid owner }
(Owner^.State AND sfExposed <> 0) { If owner exposed }
@@ -1715,17 +1777,22 @@ BEGIN
If Enable Then Command := cmReceivedFocus { View gaining focus }
Else Command := cmReleasedFocus; { View losing focus }
Message(Owner, evBroadcast, Command, @Self); { Send out message }
+ SetDrawMask(vdBorder); { Set border draw mask }
+ ShouldDraw:=true;
End;
- If (GOptions AND goDrawFocus <> 0) Then Begin { Draw focus view }
+ If (GOptions AND goDrawFocus <> 0) AND
+ (((AState XOR OldState) AND sfFocused) <> 0) Then Begin { Draw focus view }
SetDrawMask(vdFocus); { Set focus draw mask }
- DrawView; { Redraw focus change }
+ ShouldDraw:=true;
End;
End;
If (AState AND (sfCursorVis + sfCursorIns) <> 0) { Change cursor state }
Then Begin
SetDrawMask(vdCursor); { Set cursor draw mask }
- DrawView; { Redraw the cursor }
+ ShouldDraw:=true;
End;
+ If ShouldDraw then
+ DrawView; { Redraw the border }
END;
{--TView--------------------------------------------------------------------}
@@ -2270,7 +2337,7 @@ FUNCTION TGroup.FirstThat (P: Pointer): PView; ASSEMBLER;
JNZ .L_LoopPoint; { Continue to last }
XOR %EAX, %EAX; { No views gave true }
.L_Exit:
- MOVL %EAX, __RESULT; { Return result }
+ {MOVL %EAX, __RESULT;not needed for assembler functions Return result }
END;
{--TGroup-------------------------------------------------------------------}
@@ -2529,7 +2596,7 @@ BEGIN
If (Current <> Nil) Then
Current^.SetState(sfFocused, Enable); { Focus current view }
If TextModeGFV then
- SetDrawMask(vdBackGnd OR vdFocus OR vdInner); { Set redraw masks }
+ SetDrawMask(vdBackGnd OR vdFocus OR vdInner OR vdBorder); { Set redraw masks }
End;
sfExposed: Begin
ForEach(@DoExpose); { Expose each subview }
@@ -4135,6 +4202,7 @@ END;
PROCEDURE TView.ClearArea (X1, Y1, X2, Y2: Integer; Colour: Byte);
VAR
X, Y: Integer; ViewPort: ViewPortType;
+ Buf : TDrawBuffer;
BEGIN
GetViewSettings(ViewPort, TextModeGFV); { Get viewport }
If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL GFV MODE }
@@ -4147,11 +4215,12 @@ BEGIN
Y1 := (RawOrigin.Y+Y1) DIV SysFontHeight;
X2 := (RawOrigin.X+X2-1) DIV SysFontWidth;
Y2 := (RawOrigin.Y+Y2-1) DIV SysFontHeight;
+ For X := X1 To X2 Do Begin
+ Buf[X-X1]:=(Colour shl 12) or $20;
+ End;
For Y := Y1 To Y2 Do
- For X := X1 To X2 Do Begin
- VideoBuf^[(Y*Drivers.ScreenWidth+X)] := (Colour shl 12) or $20;
- End;
- UpdateScreen(false);
+ WriteAbs(X1,Y, X2-X1, Buf);
+ UpdateScreen(false);
End;
END;
@@ -4197,7 +4266,7 @@ BEGIN
Dc := ODc; { Reset held context }
End;
{$ENDIF}
- {$ENDIF not NOT_IMPLEMENTED}
+ {$ENDIF NOT_IMPLEMENTED}
END;
PROCEDURE TView.FilletArc (Xc, Yc: Integer; Sa, Ea: Real; XRad, YRad, Ht: Integer;
@@ -4205,7 +4274,7 @@ Colour: Byte);
CONST RadConv = 57.2957795130823229; { Degrees per radian }
{$IFDEF OS_WINDOWS} VAR X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer; ODc: hDc; {$ENDIF}
BEGIN
- {$IFNDEF NOT_IMPLEMENTED}
+ {$IFDEF NOT_IMPLEMENTED}
{$IFDEF OS_WINDOWS}
If (HWindow <> 0) Then Begin { Valid window }
Xc := Xc - FrameSize;
@@ -4250,7 +4319,7 @@ BEGIN
Dc := ODc; { Reset held context }
End;
{$ENDIF}
- {$ENDIF not NOT_IMPLEMENTED}
+ {$ENDIF NOT_IMPLEMENTED}
END;
{--TView--------------------------------------------------------------------}
@@ -4300,28 +4369,26 @@ BEGIN
Y := Y - ViewPort.Y1; { Calc y position }
End;
For J := 1 To H Do Begin { For each line }
- K := X; { Reset x position }
- For I := 0 To (W-1) Do Begin { For each character }
- Cw := TextWidth(Chr(Lo(P^[L]))); { Width of this char }
- If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL MODE GFV }
+ If (TextModeGFV) Then Begin { TEXT MODE GFV }
+ WriteAbs(X,Y,W,P^[L]);
+ Inc(Y);
+ Inc(L,W);
+ End Else Begin
+ K := X; { Reset x position }
+ For I := 0 To (W-1) Do Begin { For each character }
+ Cw := TextWidth(Chr(Lo(P^[L]))); { Width of this char }
SetFillStyle(SolidFill, Hi(P^[L]) AND
- $F0 SHR 4); { Set back colour }
- SetColor(Hi(P^[L]) AND $0F); { Set text colour }
- Bar(K, Y, K+Cw, Y+FontHeight-1); { Clear text backing }
- OutTextXY(K, Y+2, Chr(Lo(P^[L]))); { Write text char }
+ $F0 SHR 4); { Set back colour }
+ SetColor(Hi(P^[L]) AND $0F); { Set text colour }
+ Bar(K, Y, K+Cw, Y+FontHeight-1); { Clear text backing }
+ OutTextXY(K, Y+2, Chr(Lo(P^[L]))); { Write text char }
Inc(K,Cw);
- End else Begin
- VideoBuf^[((y * Drivers.ScreenWidth)+k)] := P^[L];
- Inc(K);
+ Inc(L); { Next character }
End;
- Inc(L); { Next character }
- End;
- If Not TextModeGFV then
- Y := Y + SysFontHeight { Next line down }
- Else
- Inc(Y); { Next line down }
- end;
+ Y := Y + SysFontHeight; { Next line down }
+ end;
Video.UpdateScreen(false);
+ End;
end;
END;
@@ -4351,25 +4418,22 @@ BEGIN
Y := Y - ViewPort.Y1; { Calc y position }
End;
For J := 1 To H Do Begin { For each line }
- K := X; { Reset x position }
- For I := 0 To (W-1) Do Begin { For each character }
- Cw := TextWidth(Chr(Lo(P^[I]))); { Width of this char }
- If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL MODE GFV }
- SetFillStyle(SolidFill, Hi(P^[I]) AND
- $F0 SHR 4); { Set back colour }
- SetColor(Hi(P^[I]) AND $0F); { Set text colour }
- Bar(K, Y, K+Cw, Y+FontHeight-1); { Clear text backing }
- OutTextXY(K, Y+2, Chr(Lo(P^[I]))); { Write text char }
- Inc(K,Cw);
- End Else Begin { TEXT MODE GFV }
- VideoBuf^[((y * Drivers.ScreenWidth)+k)] := P^[I];
- Inc(K);
- End;
+ If (TextModeGFV) Then Begin { TEXT MODE GFV }
+ WriteAbs(X,Y,W,P^);
+ Inc(Y);
+ End Else Begin
+ K := X; { Reset x position }
+ For I := 0 To (W-1) Do Begin { For each character }
+ Cw := TextWidth(Chr(Lo(P^[I]))); { Width of this char }
+ SetFillStyle(SolidFill, Hi(P^[I]) AND
+ $F0 SHR 4); { Set back colour }
+ SetColor(Hi(P^[I]) AND $0F); { Set text colour }
+ Bar(K, Y, K+Cw, Y+FontHeight-1); { Clear text backing }
+ OutTextXY(K, Y+2, Chr(Lo(P^[I]))); { Write text char }
+ Inc(K,Cw);
+ End;
+ Y := Y + SysFontHeight; { Next line down }
End;
- If Not TextModeGFV then
- Y := Y + SysFontHeight { Next line down }
- Else
- Inc(Y); { Next line down }
end;
Video.UpdateScreen(false);
End;
@@ -4406,6 +4470,7 @@ END;
PROCEDURE TView.WriteStr (X, Y: Integer; Str: String; Color: Byte);
VAR Fc, Bc, B: Byte; X1, Y1, X2, Y2: Integer;
Tix, Tiy, Ti: Integer; ViewPort: ViewPortType;
+ Buf : TDrawBuffer;
BEGIN
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfExposed <> 0) AND { View is exposed }
@@ -4441,9 +4506,9 @@ BEGIN
Tix := X DIV SysFontWidth;
Tiy := Y DIV SysFontHeight;
For Ti := 1 To length(Str) Do Begin
- VideoBuf^[((Tiy * Drivers.ScreenWidth)+Tix)] := (GetColor(Color) shl 8) or Ord(Str[Ti]);
- Inc(Tix);
+ Buf[Ti-1]:=(GetColor(Color) shl 8) or Ord(Str[Ti]);
end;
+ WriteAbs(Tix,TiY,Length(Str),Buf);
End;
UpdateScreen(false);
End;
@@ -4452,6 +4517,7 @@ END;
PROCEDURE TView.WriteChar (X, Y: Integer; C: Char; Color: Byte;
Count: Integer);
VAR Fc, Bc: Byte; I, Ti, Tix, Tiy: Integer; Col: Word; S: String; ViewPort: ViewPortType;
+ Buf : TDrawBuffer;
BEGIN
If (State AND sfVisible <> 0) AND { View visible }
(State AND sfExposed <> 0) Then Begin { View exposed }
@@ -4459,26 +4525,31 @@ BEGIN
Col := GetColor(Color); { Get view color }
Fc := Col AND $0F; { Foreground colour }
Bc := Col AND $F0 SHR 4; { Background colour }
- X := RawOrigin.X + X*FontWidth; { X position }
- Y := RawOrigin.Y + Y*FontHeight; { Y position }
+ If (X >= 0) AND (Y >= 0) AND ((GOptions and goGraphView)=0) Then Begin
+ X := RawOrigin.X+X*FontWidth; { X position }
+ Y := RawOrigin.Y+Y*FontHeight; { Y position }
+ End Else Begin
+ X := RawOrigin.X + Abs(X);
+ Y := RawOrigin.Y + Abs(Y);
+ End;
FillChar(S[1], 255, C); { Fill the string }
While (Count>0) Do Begin
- If (Count>255) Then I := 255 Else I := Count; { Size to make }
+ If (Count>Size.X) Then I := Size.X Else I := Count; { Size to make }
S[0] := Chr(I); { Set string length }
If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL MODE GFV }
SetFillStyle(SolidFill, Bc); { Set fill style }
Bar(X-ViewPort.X1, Y-ViewPort.Y1,
- X-ViewPort.X1+Length(S)*FontWidth,
+ X-ViewPort.X1+I*FontWidth,
Y-ViewPort.Y1+FontHeight-1);
SetColor(Fc);
OutTextXY(X-ViewPort.X1, Y-ViewPort.Y1, S); { Write text char }
End Else Begin { TEXT MODE GFV }
Tix := X DIV SysFontWidth;
Tiy := Y DIV SysFontHeight;
- For Ti := 1 To length(S) Do Begin
- VideoBuf^[((Tiy * Drivers.ScreenWidth)+Tix)] := (GetColor(Color) shl 8) or Ord(S[Ti]);
- Inc(Tix);
+ For Ti := 1 To I Do Begin
+ Buf[Ti-1]:=(GetColor(Color) shl 8) or Ord(S[Ti]);
End;
+ WriteAbs(TiX,TiY,Length(S),Buf);
End;
Count := Count - I; { Subtract count }
If TextModeGFV then
@@ -4491,6 +4562,138 @@ BEGIN
End;
END;
+{define DirectWrite}
+PROCEDURE TView.WriteAbs(X, Y, L : Integer; Var Buf);
+VAR
+ P: PGroup;
+ PrevP,PP : PView;
+ CurOrigin : TPoint;
+ I,XI : longint;
+ ViewPort : ViewPortType;
+BEGIN
+ { Direct wrong method }
+ GetViewSettings(ViewPort, TextModeGFV); { Get set viewport }
+{$ifdef DirectWrite}
+ For i:=0 to L-1 do Begin
+ if (X+I>=ViewPort.X1) AND (Y>=ViewPort.Y1) AND
+ (X+I<ViewPort.X2) AND (Y<ViewPort.Y2) Then
+ VideoBuf^[Y*ScreenWidth+X+i]:=TDrawBuffer(Buf)[i];
+ End;
+{$else not DirectWrite}
+ { Pedestrian character method }
+ { Must be in area }
+ If (X+L<ViewPort.X1) OR (Y<ViewPort.Y1) OR
+ (X>=ViewPort.X2) OR (Y>=ViewPort.Y2) Then
+ Exit;
+ For I:=0 to L-1 do Begin
+ P:=Owner;
+ PrevP :=@Self;
+ XI:=X+I;
+ { Must be in area }
+ If (XI<ViewPort.X1) OR
+ (XI>=ViewPort.X2) Then
+ Continue;
+ While Assigned(P) do Begin
+ if not assigned(P^.Buffer) AND
+ (((P^.State AND sfVisible) = 0) OR
+ (P^.Origin.X>XI) OR (P^.Origin.X+P^.Size.X<=XI) OR
+ (P^.Origin.Y>Y) OR (P^.Origin.Y+P^.Size.Y<=Y)) then
+ continue;
+ { Here we must check if X,Y is exposed for this view }
+ PP:=P^.Last;
+ { move to first }
+ If Assigned(PP) then
+ PP:=PP^.Next;
+ While Assigned(PP) and (PP<>P^.Last) and (PP<>PrevP) do Begin
+ If ((PP^.State AND sfVisible) <> 0) AND
+ (PP^.Origin.X>=XI) AND
+ (PP^.Origin.X+PP^.Size.X<XI) AND
+ (PP^.Origin.Y>=Y) AND
+ (PP^.Origin.Y+PP^.Size.Y<Y) then
+ exit;
+ PP:=PP^.Next;
+ End;
+
+ If Assigned(P^.Buffer) then Begin
+ P^.Buffer^[(Y-P^.Origin.Y)*P^.size.X+(XI-P^.Origin.X)]:=TDrawBuffer(Buf)[I];
+ End;
+ PrevP:=P;
+ P:=P^.Owner;
+ End;
+ End;
+{$endif not DirectWrite}
+END;
+
+{define DirectWriteShadow}
+PROCEDURE TView.WriteShadow(X1, Y1, X2, Y2 : Integer);
+VAR
+ P: PGroup;
+ PrevP,PP : PView;
+ CurOrigin : TPoint;
+ I,J : longint;
+ B : Word;
+ ViewPort : ViewPortType;
+BEGIN
+ { Direct wrong method }
+ GetViewSettings(ViewPort, TextModeGFV); { Get set viewport }
+{$ifdef DirectWriteShadow}
+ For J:=Y1 to Y2-1 do Begin
+ For i:=X1 to X2-1 do Begin
+ { if (I>=ViewPort.X1) AND (J>=ViewPort.Y1) AND
+ (I<ViewPort.X2) AND (J<ViewPort.Y2) Then }
+ Begin
+ B:=VideoBuf^[J*ScreenWidth+i];
+ VideoBuf^[J*ScreenWidth+i]:= (B and $7FF);
+ End;
+ End;
+ End;
+{$else not DirectWriteShadow}
+ { Pedestrian character method }
+ { Must be in area }
+ {If (X+L<ViewPort.X1) OR (Y<ViewPort.Y1) OR
+ (X>=ViewPort.X2) OR (Y>=ViewPort.Y2) Then
+ Exit;}
+ For J:=Y1 to Y2-1 do Begin
+ For i:=X1 to X2-1 do Begin
+ P:=Owner;
+ PrevP :=@Self;
+ { Must be in area
+ If (XI<ViewPort.X1) OR
+ (XI>=ViewPort.X2) Then
+ Continue; }
+ While Assigned(P) do Begin
+ if not assigned(P^.Buffer) AND
+ (((P^.State AND sfVisible) = 0) OR
+ (P^.Origin.X>I) OR (P^.Origin.X+P^.Size.X<=I) OR
+ (P^.Origin.Y>J) OR (P^.Origin.Y+P^.Size.Y<=J)) then
+ continue;
+ { Here we must check if X,Y is exposed for this view }
+ PP:=P^.Last;
+ { move to first }
+ If Assigned(PP) then
+ PP:=PP^.Next;
+ While Assigned(PP) and (PP<>P^.Last) and (PP<>PrevP) do Begin
+ If ((PP^.State AND sfVisible) <> 0) AND
+ (PP^.Origin.X>=I) AND
+ (PP^.Origin.X+PP^.Size.X<I) AND
+ (PP^.Origin.Y>=J) AND
+ (PP^.Origin.Y+PP^.Size.Y<J) then
+ continue;
+ PP:=PP^.Next;
+ End;
+
+ If Assigned(P^.Buffer) then Begin
+ B:=P^.Buffer^[(J-P^.Origin.Y)*P^.size.X+(I-P^.Origin.X)];
+ P^.Buffer^[(J-P^.Origin.Y)*P^.size.X+(I-P^.Origin.X)]:= (B and $7FF);
+ End;
+ PrevP:=P;
+ P:=P^.Owner;
+ End;
+ End;
+ End;
+{$endif not DirectWriteShadow}
+END;
+
PROCEDURE TView.DragView (Event: TEvent; Mode: Byte; Var Limits: TRect;
MinSize, MaxSize: TPoint);
VAR PState: Word; Mouse, Q, R, P, S, Op1, Op2: TPoint; SaveBounds: TRect;
@@ -4705,10 +4908,15 @@ END;
{--TGroup-------------------------------------------------------------------}
{ Lock -> Platforms DOS/DPMI/WIN/OS2 - Checked 23Sep97 LdB }
{---------------------------------------------------------------------------}
+{$ifndef NoLock}
+{$define UseLock}
+{$endif ndef NoLock}
PROCEDURE TGroup.Lock;
BEGIN
- If (Buffer <> Nil) OR (LockFlag <> 0)
- Then Inc(LockFlag); { Increment count }
+{$ifdef UseLock}
+ {If (Buffer <> Nil) OR (LockFlag <> 0)
+ Then} Inc(LockFlag); { Increment count }
+{$endif UseLock}
END;
{--TGroup-------------------------------------------------------------------}
@@ -4716,10 +4924,12 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE TGroup.Unlock;
BEGIN
+{$ifdef UseLock}
If (LockFlag <> 0) Then Begin
Dec(LockFlag); { Decrement count }
- {If (LockFlag = 0) Then DrawView;} { Lock release draw }
+ If (LockFlag = 0) Then DrawView; { Lock release draw }
End;
+{$endif UseLock}
END;
PROCEDURE TWindow.DrawBorder;
@@ -4878,7 +5088,10 @@ END.
{
$Log$
- Revision 1.9 2001-05-07 23:36:35 pierre
+ Revision 1.10 2001-05-10 16:46:28 pierre
+ + some improovements made
+
+ Revision 1.9 2001/05/07 23:36:35 pierre
NO_WINDOW cond removed
Revision 1.8 2001/05/04 15:43:46 pierre
diff --git a/fvision/app.pas b/fvision/app.pas
index 6097c722a6..ac21b8556e 100644
--- a/fvision/app.pas
+++ b/fvision/app.pas
@@ -22,28 +22,9 @@
{ ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. }
{ }
{*****************[ SUPPORTED PLATFORMS ]******************}
-{ 16 and 32 Bit compilers }
-{ DOS - Turbo Pascal 7.0 + (16 Bit) }
-{ DPMI - Turbo Pascal 7.0 + (16 Bit) }
-{ - FPC 0.9912+ (GO32V2) (32 Bit) }
-{ WINDOWS - Turbo Pascal 7.0 + (16 Bit) }
-{ - Delphi 1.0+ (16 Bit) }
-{ WIN95/NT - Delphi 2.0+ (32 Bit) }
-{ - Virtual Pascal 2.0+ (32 Bit) }
-{ - FPC 0.9912+ (32 Bit) }
-{ OS2 - Virtual Pascal 1.0+ (32 Bit) }
{ }
-{******************[ REVISION HISTORY ]********************}
-{ Version Date Fix }
-{ ------- --------- --------------------------------- }
-{ 1.00 12 Dec 96 First multi platform release }
-{ 1.10 12 Sep 97 FPK pascal 0.92 conversion added. }
-{ 1.20 29 Aug 97 Platform.inc sort added. }
-{ 1.30 05 May 98 Virtual pascal 2.0 code added. }
-{ 1.40 22 Oct 99 Object registration added. }
-{ 1.50 22 Oct 99 Complete recheck preformed }
-{ 1.51 03 Nov 99 FPC Windows support added }
-{ 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }
+{ Only Free Pascal Compiler supported }
+{ }
{**********************************************************}
UNIT App;
@@ -58,17 +39,6 @@ UNIT App;
{==== Compiler directives ===========================================}
-{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
- {$F-} { Near calls are okay }
- {$A+} { Word Align Data }
- {$B-} { Allow short circuit boolean evaluations }
- {$O+} { This unit may be overlaid }
- {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
- {$P-} { Normal string variables }
- {$N-} { No 80x87 code generation }
- {$E+} { Emulation is on }
-{$ENDIF}
-
{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
{$S-} { Disable Stack Checking }
@@ -79,21 +49,7 @@ UNIT App;
USES
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
- {$IFNDEF PPC_SPEED} { NON SPEED COMPILER }
- {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
Windows, { Standard units }
- {$ELSE} { OTHER COMPILERS }
- WinTypes,WinProcs, { Standard units }
- {$ENDIF}
- {$IFNDEF PPC_DELPHI} { NON DELPHI1 COMPILER }
- {$IFDEF BIT_16} Win31, {$ENDIF} { 16 BIT WIN 3.1 UNIT }
- {$ENDIF}
- {$ELSE} { SPEEDSOFT COMPILER }
- WinBase, WinDef, { Standard units }
- {$ENDIF}
- {$IFDEF PPC_DELPHI} { DELPHI COMPILERS }
- Messages, { Standard unit }
- {$ENDIF}
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
@@ -162,8 +118,7 @@ CONST
{ Turbo Vision 2.0 Color Palettes }
CAppColor =
- {$IFDEF OS_WINDOWS}#$81+{$ELSE}#$71+{$ENDIF}
- #$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F +
+ #$71#$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F +
#$37#$3F#$3A#$13#$13#$3E#$21#$3F#$70#$7F#$7A#$13#$13#$70#$7F#$7E +
#$70#$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 +
#$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 +
@@ -356,11 +311,7 @@ PROCEDURE RegisterApp;
CONST
RBackGround: TStreamRec = (
ObjType: 30; { Register id = 30 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TBackGround)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TBackGround);
- {$ENDIF}
Load: @TBackGround.Load; { Object load method }
Store: @TBackGround.Store { Object store method }
);
@@ -371,11 +322,7 @@ CONST
CONST
RDeskTop: TStreamRec = (
ObjType: 31; { Register id = 31 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TDeskTop)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TDeskTop);
- {$ENDIF}
Load: @TDeskTop.Load; { Object load method }
Store: @TDeskTop.Store { Object store method }
);
@@ -398,10 +345,8 @@ CONST
IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
-{$ifdef Use_API}
uses
Video,Mouse;
-{$endif Use_API}
{***************************************************************************}
{ PRIVATE DEFINED CONSTANTS }
@@ -416,80 +361,6 @@ CONST
{---------------------------------------------------------------------------}
CONST Pending: TEvent = (What: evNothing); { Pending event }
-{***************************************************************************}
-{ PRIVATE INTERNAL ROUTINES }
-{***************************************************************************}
-{$IFDEF OS_WINDOWS}
-{---------------------------------------------------------------------------}
-{ AppMsgHandler -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 13May98 LdB }
-{---------------------------------------------------------------------------}
-FUNCTION TvAppMsgHandler (Wnd: hWnd; iMessage, wParam: Sw_Word;
-lParam: LongInt): LongInt; {$IFDEF BIT_16} EXPORT; {$ELSE} STDCALL; {$ENDIF}
-VAR Event: TEvent; P: PView; Mm: ^TMinMaxInfo;
-BEGIN
- {$IFDEF BIT_16} { 16 BIT CODE }
- PtrRec(P).Seg := GetProp(Wnd, ViewSeg); { Fetch seg property }
- PtrRec(P).Ofs := GetProp(Wnd, ViewOfs); { Fetch ofs property }
- {$ENDIF}
- {$IFDEF BIT_32} { 32 BIT CODE }
- LongInt(P) := GetProp(Wnd, ViewPtr); { Fetch view property }
- {$ENDIF}
- TvAppMsgHandler := 0; { Preset zero return }
- Event.What := evNothing; { Preset no event }
- Case iMessage Of
- WM_Destroy:; { Destroy window }
- WM_Close: Begin
- Event.What := evCommand; { Command event }
- Event.Command := cmQuit; { Quit command }
- Event.InfoPtr := Nil; { Clear info ptr }
- End;
- WM_GetMinMaxInfo: Begin { Get minmax info }
- TvAppMsgHandler := DefWindowProc(Wnd,
- iMessage, wParam, lParam); { Default handler }
- Mm := Pointer(lParam); { Create pointer }
- Mm^.ptMaxSize.X := SysScreenWidth; { Max x size }
- Mm^.ptMaxSize.Y := SysScreenHeight; { Max y size }
- Mm^.ptMinTrackSize.X := MinWinSize.X *
- SysFontWidth; { Drag min x size }
- Mm^.ptMinTrackSize.Y := MinWinSize.Y *
- SysFontHeight; { Drag min y size }
- Mm^.ptMaxTrackSize.X := SysScreenWidth; { Drag max x size }
- Mm^.ptMaxTrackSize.Y := SysScreenHeight; { Drag max y size }
- End;
- Else Begin { Unhandled message }
- TvAppMsgHandler := DefWindowProc(Wnd,
- iMessage, wParam, lParam); { Default handler }
- Exit; { Now exit }
- End;
- End;
- If (Event.What <> evNothing) Then { Check any FV event }
- PutEventInQueue(Event); { Put event in queue }
-END;
-{$ENDIF}
-{$IFDEF OS_OS2} { OS2 CODE }
-FUNCTION TvAppMsgHandler(Wnd: HWnd; Msg: ULong; Mp1, Mp2: MParam): MResult; CDECL;
-VAR Event: TEvent; P: PView;
-BEGIN
- Event.What := evNothing; { Preset no event }
- TvAppMsgHandler := 0; { Preset zero return }
- Case Msg Of
- WM_Destroy:; { Destroy window }
- WM_Close: Begin
- Event.What := evCommand; { Command event }
- Event.Command := cmQuit; { Quit command }
- Event.InfoPtr := Nil; { Clear info ptr }
- End;
- Else Begin { Unhandled message }
- TvAppMsgHandler := WinDefWindowProc(Wnd,
- Msg, Mp1, Mp2); { Call std handler }
- Exit; { Now exit }
- End;
- End;
- If (Event.What <> evNothing) Then { Check any FV event }
- PutEventInQueue(Event); { Put event in queue }
-END;
-{$ENDIF}
-
{---------------------------------------------------------------------------}
{ Tileable -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
{---------------------------------------------------------------------------}
@@ -558,11 +429,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
{---------------------------------------------------------------------------}
FUNCTION TBackGround.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CBackGround; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CBackGround)] = CbackGround; { Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@@ -776,7 +643,6 @@ END;
{ TProgram OBJECT METHODS }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-CONST TvProgramClassName = 'TVPROGRAM'+#0; { TV program class }
{--TProgram-----------------------------------------------------------------}
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
@@ -784,11 +650,11 @@ CONST TvProgramClassName = 'TVPROGRAM'+#0; { TV program class }
CONSTRUCTOR TProgram.Init;
VAR I: Integer; R: TRect;
BEGIN
- Application := @Self; { Set application ptr }
- InitScreen; { Initialize screen }
R.Assign(0, 0, -(GetMaxX(TextModeGFV)+1),
-(GetMaxY(TextModeGFV)+1)); { Full screen area }
Inherited Init(R); { Call ancestor }
+ Application := @Self; { Set application ptr }
+ InitScreen; { Initialize screen }
State := sfVisible + sfSelected + sfFocused +
sfModal + sfExposed; { Deafult states }
Options := 0; { No options set }
@@ -810,6 +676,9 @@ END;
DESTRUCTOR TProgram.Done;
VAR I: Integer;
BEGIN
+ { Do not free the Buffer of Video Unit }
+ If Buffer = Views.PVideoBuf(VideoBuf) then
+ Buffer:=nil;
If (Desktop <> Nil) Then Dispose(Desktop, Done); { Destroy desktop }
If (MenuBar <> Nil) Then Dispose(MenuBar, Done); { Destroy menu bar }
If (StatusLine <> Nil) Then
@@ -916,22 +785,6 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE TProgram.InitScreen;
BEGIN
-{$ifndef Use_API}
- If (Lo(ScreenMode) <> smMono) Then Begin { Coloured mode }
- If (ScreenMode AND smFont8x8 <> 0) Then
- ShadowSize.X := 1 Else { Single bit shadow }
- ShadowSize.X := 2; { Double size }
- ShadowSize.Y := 1; ShowMarkers := False; { Set variables }
- If (Lo(ScreenMode) = smBW80) Then
- AppPalette := apBlackWhite Else { B & W palette }
- AppPalette := apColor; { Coloured palette }
- End Else Begin
- ShadowSize.X := 0; { No x shadow size }
- ShadowSize.Y := 0; { No y shadow size }
- ShowMarkers := True; { Show markers }
- AppPalette := apMonochrome; { Mono palette }
- End;
-{$else Use_API}
{ the orginal code can't be used here because of the limited
video unit capabilities, the mono modus can't be handled
}
@@ -947,7 +800,6 @@ BEGIN
else
AppPalette := apBlackWhite;
Buffer := Views.PVideoBuf(VideoBuf);
-{$endif Use_API}
END;
{--TProgram-----------------------------------------------------------------}
@@ -1023,6 +875,10 @@ BEGIN
NextQueuedEvent(Event); { Next queued event }
If (Event.What = evNothing) Then Begin
GetKeyEvent(Event); { Fetch key event }
+{$ifdef DEBUG}
+ If (Event.What = evKeyDown) then
+ Writeln(stderr,'Key pressed scancode = ',hexstr(Event.Keycode,4));
+{$endif}
If (Event.What = evNothing) Then Begin { No mouse event }
Drivers.GetMouseEvent(Event); { Load mouse event }
If (Event.What = evNothing) Then Idle; { Idle if no event }
@@ -1227,7 +1083,10 @@ END;
END.
{
$Log$
- Revision 1.8 2001-05-07 22:22:03 pierre
+ Revision 1.9 2001-05-10 16:46:26 pierre
+ + some improovements made
+
+ Revision 1.8 2001/05/07 22:22:03 pierre
* removed NO_WINDOW cond, added GRAPH_API
Revision 1.7 2001/05/04 15:43:45 pierre
@@ -1247,8 +1106,17 @@ END.
Revision 1.2 2000/08/24 11:43:13 marco
* Added CVS log and ID entries.
-
-
}
+{******************[ REVISION HISTORY ]********************}
+{ Version Date Fix }
+{ ------- --------- --------------------------------- }
+{ 1.00 12 Dec 96 First multi platform release }
+{ 1.10 12 Sep 97 FPK pascal 0.92 conversion added. }
+{ 1.20 29 Aug 97 Platform.inc sort added. }
+{ 1.30 05 May 98 Virtual pascal 2.0 code added. }
+{ 1.40 22 Oct 99 Object registration added. }
+{ 1.50 22 Oct 99 Complete recheck preformed }
+{ 1.51 03 Nov 99 FPC Windows support added }
+{ 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }
diff --git a/fvision/dialogs.pas b/fvision/dialogs.pas
index 37e815ad80..360dd5a198 100644
--- a/fvision/dialogs.pas
+++ b/fvision/dialogs.pas
@@ -1,4 +1,4 @@
-{ $Id: }
+{ $Id$ }
{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
{ }
{ System independent GRAPHICAL clone of DIALOGS.PAS }
@@ -21,29 +21,9 @@
{ ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. }
{ }
{*****************[ SUPPORTED PLATFORMS ]******************}
-{ 16 and 32 Bit compilers }
-{ DOS - Turbo Pascal 7.0 + (16 Bit) }
-{ DPMI - Turbo Pascal 7.0 + (16 Bit) }
-{ - FPC 0.9912+ (GO32V2) (32 Bit) }
-{ WINDOWS - Turbo Pascal 7.0 + (16 Bit) }
-{ - Delphi 1.0+ (16 Bit) }
-{ WIN95/NT - Delphi 2.0+ (32 Bit) }
-{ - Virtual Pascal 2.0+ (32 Bit) }
-{ - Speedsoft Sybil 2.0+ (32 Bit) }
-{ - FPC 0.9912+ (32 Bit) }
-{ OS2 - Virtual Pascal 1.0+ (32 Bit) }
{ }
-{******************[ REVISION HISTORY ]********************}
-{ Version Date Fix }
-{ ------- --------- --------------------------------- }
-{ 1.00 11 Nov 96 First DOS/DPMI platform release. }
-{ 1.10 13 Jul 97 Windows platform code added. }
-{ 1.20 29 Aug 97 Platform.inc sort added. }
-{ 1.30 13 Oct 97 Delphi 2 32 bit code added. }
-{ 1.40 05 May 98 Virtual pascal 2.0 code added. }
-{ 1.50 27 Oct 99 All objects completed and checked }
-{ 1.51 03 Nov 99 FPC windows support added }
-{ 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }
+{ Only Free Pascal Compiler supported }
+{ }
{**********************************************************}
UNIT Dialogs;
@@ -58,16 +38,6 @@ UNIT Dialogs;
{==== Compiler directives ===========================================}
-{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
- {$F-} { Short calls are okay }
- {$A+} { Word Align Data }
- {$B-} { Allow short circuit boolean evaluations }
- {$O+} { This unit may be overlaid }
- {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
- {$P-} { Normal string variables }
- {$N-} { No 80x87 code generation }
- {$E+} { Emulation is on }
-{$ENDIF}
{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
@@ -79,18 +49,7 @@ UNIT Dialogs;
USES
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
- {$IFNDEF PPC_SPEED} { NON SPEED COMPILER }
- {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
Windows, { Standard units }
- {$ELSE} { OTHER COMPILERS }
- WinTypes,WinProcs, { Standard units }
- {$ENDIF}
- {$ELSE} { SPEEDSOFT COMPILER }
- WinBase, WinDef, WinUser, WinGDI, { Standard units }
- {$ENDIF}
- {$IFDEF PPC_DELPHI} { DELPHI COMPILERS }
- Messages, { Standard unit }
- {$ENDIF}
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
@@ -127,14 +86,6 @@ CONST
CDialog = CGrayDialog; { Default palette }
-{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
-{---------------------------------------------------------------------------}
-{ NEW WIN/NT/OS2 COMMAND CODES }
-{---------------------------------------------------------------------------}
-CONST
- cmTvClusterButton = $2001; { Cluster button cmd id }
-{$ENDIF}
-
{---------------------------------------------------------------------------}
{ TDialog PALETTE COLOUR CONSTANTS }
{---------------------------------------------------------------------------}
@@ -492,11 +443,7 @@ PROCEDURE RegisterDialogs;
CONST
RDialog: TStreamRec = (
ObjType: 10; { Register id = 10 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TDialog)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TDialog);
- {$ENDIF}
Load: @TDialog.Load; { Object load method }
Store: @TDialog.Store { Object store method }
);
@@ -507,11 +454,7 @@ CONST
CONST
RInputLine: TStreamRec = (
ObjType: 11; { Register id = 11 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TInputLine)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TInputLine);
- {$ENDIF}
Load: @TInputLine.Load; { Object load method }
Store: @TInputLine.Store { Object store method }
);
@@ -522,11 +465,7 @@ CONST
CONST
RButton: TStreamRec = (
ObjType: 12; { Register id = 12 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TButton)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TButton);
- {$ENDIF}
Load: @TButton.Load; { Object load method }
Store: @TButton.Store { Object store method }
);
@@ -537,11 +476,7 @@ CONST
CONST
RCluster: TStreamRec = (
ObjType: 13; { Register id = 13 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TCluster)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TCluster);
- {$ENDIF}
Load: @TCluster.Load; { Object load method }
Store: @TCluster.Store { Objects store method }
);
@@ -552,11 +487,7 @@ CONST
CONST
RRadioButtons: TStreamRec = (
ObjType: 14; { Register id = 14 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TRadioButtons)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TRadioButtons);
- {$ENDIF}
Load: @TRadioButtons.Load; { Object load method }
Store: @TRadioButtons.Store { Object store method }
);
@@ -567,11 +498,7 @@ CONST
CONST
RCheckBoxes: TStreamRec = (
ObjType: 15; { Register id = 15 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TCheckBoxes)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TCheckBoxes);
- {$ENDIF}
Load: @TCheckBoxes.Load; { Object load method }
Store: @TCheckBoxes.Store { Object store method }
);
@@ -582,11 +509,7 @@ CONST
CONST
RMultiCheckBoxes: TStreamRec = (
ObjType: 27; { Register id = 27 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TMultiCheckBoxes)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TMultiCheckBoxes);
- {$ENDIF}
Load: @TMultiCheckBoxes.Load; { Object load method }
Store: @TMultiCheckBoxes.Store { Object store method }
);
@@ -597,11 +520,7 @@ CONST
CONST
RListBox: TStreamRec = (
ObjType: 16; { Register id = 16 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TListBox)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TListBox);
- {$ENDIF}
Load: @TListBox.Load; { Object load method }
Store: @TListBox.Store { Object store method }
);
@@ -612,11 +531,7 @@ CONST
CONST
RStaticText: TStreamRec = (
ObjType: 17; { Register id = 17 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TStaticText)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TStaticText);
- {$ENDIF}
Load: @TStaticText.Load; { Object load method }
Store: @TStaticText.Store { Object store method }
);
@@ -627,11 +542,7 @@ CONST
CONST
RLabel: TStreamRec = (
ObjType: 18; { Register id = 18 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TLabel)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TLabel);
- {$ENDIF}
Load: @TLabel.Load; { Object load method }
Store: @TLabel.Store { Object store method }
);
@@ -642,11 +553,7 @@ CONST
CONST
RHistory: TStreamRec = (
ObjType: 19; { Register id = 19 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(THistory)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(THistory);
- {$ENDIF}
Load: @THistory.Load; { Object load method }
Store: @THistory.Store { Object store method }
);
@@ -657,11 +564,7 @@ CONST
CONST
RParamText: TStreamRec = (
ObjType: 20; { Register id = 20 }
- {$IFDEF BP_VMTLink} { BP style VMT link }
- VmtLink: Ofs(TypeOf(TParamText)^);
- {$ELSE} { Alt style VMT link }
VmtLink: TypeOf(TParamText);
- {$ENDIF}
Load: @TParamText.Load; { Object load method }
Store: @TParamText.Store { Object store method }
);
@@ -679,10 +582,7 @@ USES HistList; { Standard GFV unit }
{---------------------------------------------------------------------------}
{ LEFT AND RIGHT ARROW CHARACTER CONSTANTS }
{---------------------------------------------------------------------------}
-{$IFDEF OS_DOS} CONST LeftArr = #17; RightArr = #16; {$ENDIF}
-{$IFDEF OS_LINUX} CONST LeftArr = #17; RightArr = #16; {$ENDIF}
-{$IFDEF OS_WINDOWS} CONST LeftArr = #$AB; RightArr = #$BB; {$ENDIF}
-{$IFDEF OS_OS2} CONST LeftArr = #17; RightArr = #16; {$ENDIF}
+CONST LeftArr = #17; RightArr = #16;
{---------------------------------------------------------------------------}
{ TButton MESSAGES }
@@ -730,10 +630,6 @@ BEGIN
GrowMode := 0; { Clear grow mode }
Flags := wfMove + wfClose; { Close/moveable flags }
Palette := dpGrayDialog; { Default gray colours }
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- GOptions := GOptions AND NOT goThickFramed; { Turn thick frame off }
- ExStyle := ws_Ex_DlgModalFrame; { Set extended style }
- {$ENDIF}
END;
{--TDialog------------------------------------------------------------------}
@@ -752,13 +648,8 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TDialog.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: Array[dpBlueDialog..dpGrayDialog] Of String =
- (CBlueDialog, CCyanDialog, CGrayDialog); { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: Array[dpBlueDialog..dpGrayDialog] Of String[Length(CBlueDialog)] =
(CBlueDialog, CCyanDialog, CGrayDialog); { Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P[Palette]; { Return palette }
END;
@@ -844,11 +735,7 @@ BEGIN
If (MaxAvail > MaxLen+1) Then Begin { Check enough memory }
GetMem(Data, MaxLen + 1); { Allocate memory }
S.Read(Data^[1], Length(Data^)); { Read string data }
- {$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
SetLength(Data^, B); { Xfer string length }
- {$ELSE} { OTHER COMPILERS }
- Data^[0] := Chr(B); { Set string length }
- {$ENDIF}
End Else S.Seek(S.GetPos + B); { Move to position }
If (Options AND ofVersion >= ofVersion20) Then { Version 2 or above }
Validator := PValidator(S.Get); { Get any validator }
@@ -883,11 +770,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TInputLine.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CInputLine; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CInputLine)] = CInputLine; { Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@@ -1048,18 +931,11 @@ END;
{ SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TInputLine.SetData (Var Rec);
-{$IFDEF PPC_DELPHI3} VAR Buf: Array [0..256] Of Char; {$ENDIF}
BEGIN
If (Data <> Nil) Then Begin { Data ptr valid }
If (Validator = Nil) OR (Validator^.Transfer(
Data^, @Rec, vtSetData) = 0) Then { No validator/data }
- {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
- Move(Rec, Buf, DataSize); { Fetch our data }
- Move(Buf[1], Data^[1], Ord(Buf[0])); { Tranfer string }
- SetLength(Data^, Ord(Buf[0])); { Set string length }
- {$ELSE} { OTHER COMPILERS }
Move(Rec, Data^[0], DataSize); { Set our data }
- {$ENDIF}
End;
SelectAll(True); { Now select all }
END;
@@ -1169,11 +1045,7 @@ Delta, Anchor, OldCurPos, OldFirstPos, OldSelStart, OldSelEnd: Integer;
If NOT Validator^.IsValidInput(NewData,
NoAutoFill) Then RestoreState Else Begin
If (Length(NewData) > MaxLen) Then { Exceeds maximum }
- {$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
SetLength(NewData, MaxLen); { Set string length }
- {$ELSE} { OTHER COMPILERS }
- NewData[0] := Chr(MaxLen); { Set string length }
- {$ENDIF}
If (Data <> Nil) Then Data^ := NewData; { Set data value }
If (Data <> Nil) AND (CurPos >= OldLen) { Cursor beyond end }
AND (Length(Data^) > OldLen) Then { Cursor beyond string }
@@ -1210,11 +1082,7 @@ BEGIN
SelectAll(True) Else Begin { Select whole text }
Anchor := MousePos; { Start of selection }
Repeat
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
If (Event.What = evMouseAuto) { Mouse auto event }
- {$ELSE} { WIN/NT/OS2 CODE }
- If (Event.What = evMouseMove) { Mouse move event }
- {$ENDIF}
Then Begin
Delta := MouseDelta; { New position }
If CanScroll(Delta) Then { If can scroll }
@@ -1304,11 +1172,7 @@ BEGIN
If (Data <> Nil) Then OldData := Copy(Data^,
FirstPos+1, CurPos-FirstPos) { Text area string }
Else OldData := ''; { Empty string }
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
Delta := FontWidth; { Safety = 1 char }
- {$ELSE} { WIN/NT CODE }
- Delta := 2*FontWidth; { Safety = 2 char }
- {$ENDIF}
While (TextWidth(OldData) > ((RawSize.X+1)-Delta)
- TextWidth(LeftArr) - TextWidth(RightArr)) { Check text fits }
Do Begin
@@ -1396,11 +1260,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TButton.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CButton; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CButton)] = CButton; { Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Get button palette }
END;
@@ -1455,15 +1315,15 @@ BEGIN
I := (RawSize.X - I) DIV 2; { Centre in button }
End Else I := FontWidth; { Left edge of button }
MoveCStr(Db, Title^, Bc); { Move title to buffer }
-{$ifndef USE_API}
- GOptions := GOptions OR goGraphView; { Graphics co-ords mode }
- WriteLine(I, FontHeight DIV 2, CStrLen(Title^),
- 1, Db); { Write the title }
- GOptions := GOptions AND NOT goGraphView; { Return to normal mode }
-{$else USE_API}
- WriteLine(I div SysFontWidth, 0, CStrLen(Title^),
- 1, Db); { Write the title }
-{$endif USE_API}
+ If not TextModeGFV then Begin
+ GOptions := GOptions OR goGraphView; { Graphics co-ords mode }
+ WriteLine(I, FontHeight DIV 2, CStrLen(Title^),
+ 1, Db); { Write the title }
+ GOptions := GOptions AND NOT goGraphView; { Return to normal mode }
+ End Else Begin
+ WriteLine(I div SysFontWidth, 0, CStrLen(Title^),
+ 1, Db); { Write the title }
+ End;
End;
END;
@@ -1671,11 +1531,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TCluster.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CCluster; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CCluster)] = CCluster; { Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Cluster palette }
END;
@@ -1950,7 +1806,6 @@ BEGIN
Exit; { Now exit }
End;
End;
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
If (Event.CharCode = ' ') AND { Spacebar key }
(State AND sfFocused <> 0) AND { Check focused view }
ButtonState(Sel) Then Begin { Check item enabled }
@@ -1959,7 +1814,6 @@ BEGIN
DrawView; { Now draw changes }
ClearEvent(Event); { Event was handled }
End;
- {$ENDIF}
End;
End;
End;
@@ -2275,7 +2129,6 @@ END;
{ NewList -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TListBox.NewList (AList: PCollection);
-{$IFDEF OS_WINDOWS} VAR I: Integer; S: String; P: PString; {$ENDIF}
BEGIN
If (List <> Nil) Then Dispose(List, Done); { Dispose old list }
List := AList; { Hold new list }
@@ -2348,11 +2201,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TStaticText.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CStaticText; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CStaticText)] = CStaticText; { Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@@ -2509,11 +2358,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TLabel.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CLabel; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CLabel)] = CLabel; { Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@@ -2620,11 +2465,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION THistoryViewer.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CHistoryViewer; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CHistoryViewer)] = CHistoryViewer;{ Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Return palette }
END;
@@ -2684,11 +2525,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION THistoryWindow.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CHistoryWindow; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CHistoryWindow)] = CHistoryWindow;{ Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Return the palette }
END;
@@ -2739,11 +2576,7 @@ END;
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION THistory.GetPalette: PPalette;
-{$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
-CONST P: String = CHistory; { Possible huge string }
-{$ELSE} { OTHER COMPILERS }
CONST P: String[Length(CHistory)] = CHistory; { Always normal string }
-{$ENDIF}
BEGIN
GetPalette := @P; { Return the palette }
END;
@@ -2816,11 +2649,7 @@ BEGIN
If (C = cmOk) Then Begin { Result was okay }
Rslt := HistoryWindow^.GetSelection; { Get history selection }
If Length(Rslt) > Link^.MaxLen Then
- {$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
SetLength(Rslt, Link^.MaxLen); { Hold new length }
- {$ELSE}
- Rslt[0] := Char(Link^.MaxLen); { Hold new length }
- {$ENDIF}
Link^.Data^ := Rslt; { Hold new selection }
Link^.SelectAll(True); { Select all string }
Link^.DrawView; { Redraw link view }
@@ -2881,7 +2710,10 @@ END;
END.
{
$Log$
- Revision 1.7 2001-05-07 22:22:03 pierre
+ Revision 1.8 2001-05-10 16:46:27 pierre
+ + some improovements made
+
+ Revision 1.7 2001/05/07 22:22:03 pierre
* removed NO_WINDOW cond, added GRAPH_API
Revision 1.6 2001/05/04 10:46:01 pierre
@@ -2898,6 +2730,16 @@ END.
Revision 1.2 2000/08/24 12:00:20 marco
* CVS log and ID tags
-
-
}
+{******************[ REVISION HISTORY ]********************}
+{ Version Date Fix }
+{ ------- --------- --------------------------------- }
+{ 1.00 11 Nov 96 First DOS/DPMI platform release. }
+{ 1.10 13 Jul 97 Windows platform code added. }
+{ 1.20 29 Aug 97 Platform.inc sort added. }
+{ 1.30 13 Oct 97 Delphi 2 32 bit code added. }
+{ 1.40 05 May 98 Virtual pascal 2.0 code added. }
+{ 1.50 27 Oct 99 All objects completed and checked }
+{ 1.51 03 Nov 99 FPC windows support added }
+{ 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }
+{**********************************************************}
diff --git a/fvision/drivers.pas b/fvision/drivers.pas
index 307c2d483d..fed218c85b 100644
--- a/fvision/drivers.pas
+++ b/fvision/drivers.pas
@@ -27,43 +27,9 @@
{ ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. }
{ }
{*****************[ SUPPORTED PLATFORMS ]******************}
-{ 16 and 32 Bit compilers }
-{ DOS - Turbo Pascal 7.0 + (16 Bit) }
-{ DPMI - Turbo Pascal 7.0 + (16 Bit) }
-{ - FPC 0.9912+ (GO32V2) (32 Bit) }
-{ WINDOWS - Turbo Pascal 7.0 + (16 Bit) }
-{ - Delphi 1.0+ (16 Bit) }
-{ WIN95/NT - Delphi 2.0+ (32 Bit) }
-{ - Virtual Pascal 2.0+ (32 Bit) }
-{ - Speedsoft Sybil 2.0+ (32 Bit) }
-{ - FPC 0.9912+ (32 Bit) }
-{ OS2 - Virtual Pascal 1.0+ (32 Bit) }
-{ - Speed Pascal 1.0+ (32 Bit) }
{ }
-{******************[ REVISION HISTORY ]********************}
-{ Version Date Fix }
-{ ------- --------- --------------------------------- }
-{ 1.00 26 Jul 96 First DOS/DPMI platform release }
-{ 1.10 18 Nov 97 Windows conversion added. }
-{ 1.20 29 Aug 97 Platform.inc sort added. }
-{ 1.30 10 Jun 98 Virtual pascal 2.0 code added. }
-{ 1.40 13 Jul 98 Added FormatStr by Marco Schmidt. }
-{ 1.50 14 Jul 98 Fixed width = 0 in FormatStr. }
-{ 1.60 13 Aug 98 Complete rewrite of FormatStr. }
-{ 1.70 10 Sep 98 Added mouse int hook for FPC. }
-{ 1.80 10 Sep 98 Checks run & commenting added. }
-{ 1.90 15 Oct 98 Fixed for FPC version 0.998 }
-{ 1.91 18 Feb 99 Added PrintStr functions }
-{ 1.92 18 Feb 99 FormatStr literal '%' fix added }
-{ 1.93 10 Jul 99 Sybil 2.0 code added }
-{ 1.94 15 Jul 99 Fixed for FPC 0.9912 release }
-{ 1.95 26 Jul 99 Windows..Scales to GFV system font }
-{ 1.96 30 Jul 99 Fixed Ctrl+F1..F10 in GetKeyEvent }
-{ 1.97 07 Sep 99 InitEvent, DoneEvent fixed for OS2 }
-{ 1.98 09 Sep 99 GetMouseEvent fixed for OS2. }
-{ 1.99 03 Nov 99 FPC windows support added. }
-{ 2.00 26 Nov 99 Graphics stuff moved to GFVGraph }
-{ 2.01 21 May 00 DOS fixed to use std GRAPH unit }
+{ Only Free Pascal Compiler supported }
+{ }
{**********************************************************}
UNIT Drivers;
@@ -78,17 +44,6 @@ UNIT Drivers;
{==== Compiler directives ===========================================}
-{$IFNDEF PPC_FPC} { FPC doesn't support these switches }
- {$F+} { Force far calls - Used because of the ShowMouseProc etc... }
- {$A+} { Word Align Data }
- {$B-} { Allow short circuit boolean evaluations }
- {$O-} { This unit may >>> NOT <<< be overlaid }
- {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
- {$P-} { Normal string variables }
- {$N-} { No 80x87 code generation }
- {$E+} { Emulation is on }
-{$ENDIF}
-
{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
{$IFNDEF OS_LINUX}
@@ -101,21 +56,7 @@ UNIT Drivers;
USES
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
- {$IFNDEF PPC_SPEED} { NON SPEED COMPILER }
- {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
Windows, { Standard unit }
- {$ELSE} { OTHER COMPILERS }
- WinTypes, WinProcs, Strings, { Standard units }
- {$IFDEF BIT_16} { 16 BIT WINDOWS COMPILER }
- Win31, { Standard unit }
- {$ENDIF}
- {$ENDIF}
- {$IFDEF PPC_DELPHI} { DELPHI3+ COMPILER }
- SysUtils, Messages, { Standard unit }
- {$ENDIF}
- {$ELSE} { SYBIL2+ COMPILER }
- WinBase, WinDef, WinUser, WinGDI, { Standard units }
- {$ENDIF}
{$ENDIF}
{$IFDEF OS_OS2} { OS2 CODE }
@@ -133,18 +74,10 @@ USES
{$else}
unix,
{$endif}
- {$DEFINE Use_API}
{$ENDIF}
- {$ifdef Use_API}
video,
- {$endif Use_API}
GFVGraph, { GFV graphics unit }
- {$ifndef Use_API}
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
- Graph, { Standard bp unit }
- {$ENDIF}
- {$endif not Use_API}
Common, Objects; { GFV standard units }
{***************************************************************************}
@@ -582,50 +515,9 @@ PROCEDURE NextQueuedEvent(Var Event: TEvent);
{ INITIALIZED PUBLIC VARIABLES }
{***************************************************************************}
-{---------------------------------------------------------------------------}
-{ INITIALIZED DOS/DPMI VARIABLES }
-{---------------------------------------------------------------------------}
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
-{ ******************************* REMARK ****************************** }
-{ In Hi-Res graphics modes where the usual mouse handler will not }
-{ work these can be set so the user can provide his own hide, show }
-{ and redraw on move routines, otherwise leave them set as nil. }
-{ ****************************** END REMARK *** Leon de Boer, 20Jul98 * }
-TYPE DrawProc = PROCEDURE;
-
-CONST
- HideMouseProc: DrawProc = Nil; { Hide mouse procedure }
- ShowMouseProc: DrawProc = Nil; { Show mouse procedure }
- MouseMoveProc: DrawProc = Nil; { Mouse moved procedure }
-{$ENDIF}
-
PROCEDURE HideMouseCursor;
PROCEDURE ShowMouseCursor;
-{---------------------------------------------------------------------------}
-{ INITIALIZED WIN/NT VARIABLES }
-{---------------------------------------------------------------------------}
-{$IFDEF OS_WINDOWS} { WIN/NT CODE }
-CONST
- RawHandler : Boolean = False;
- AppWindow : HWnd = 0; { Application window }
- DefGfvFont : HFont = 0; { Default GFV font }
- DefFontWeight: Integer = fw_Normal; { Default font weight }
- DefFontStyle : String = 'Times New Roman'; { Default font style }
-{$ENDIF}
-
-{---------------------------------------------------------------------------}
-{ INITIALIZED OS2 VARIABLES }
-{---------------------------------------------------------------------------}
-{$IFDEF OS_OS2} { OS2 CODE }
-CONST
- AppWindow : HWnd = 0; { Application window }
- Anchor : HAB = 0; { Anchor block }
- MsgQue : HMq = 0; { Message queue }
- DefGFVFont : LongInt = 0; { Default font style }
- DefPointer : HPointer = 0; { Default pointer }
- DefFontStyle: String = 'Times'; { Default font style }
-{$ENDIF}
{---------------------------------------------------------------------------}
{ INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES }
@@ -672,43 +564,27 @@ VAR
MouseButtons: Byte; { Mouse button state }
ScreenWidth : Byte; { Screen text width }
ScreenHeight: Byte; { Screen text height }
-{$ifndef Use_API}
+{$ifdef GRAPH_API}
ScreenMode : Word; { Screen mode }
-{$else Use_API}
+{$else not GRAPH_API}
ScreenMode : TVideoMode; { Screen mode }
-{$endif Use_API}
+{$endif GRAPH_API}
MouseWhere : TPoint; { Mouse position }
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
-{$ifdef Use_API}
{ API Units }
USES Keyboard,Mouse;
-{$else not Use_API}
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
- {$IFDEF PPC_FPC} { FPC DOS COMPILER }
- USES Go32; { Standard unit }
- {$ENDIF}
-{$ENDIF}
-{$endif not Use_API}
{***************************************************************************}
{ PRIVATE INTERNAL CONSTANTS }
{***************************************************************************}
-{$IFDEF OS_DOS} { DOS/DPMI/API CODE }
-{$define Has_vars}
-{$ENDIF OS_DOS}
-{$IFDEF Use_API}
-{$define Has_vars}
-{$ENDIF Use_API}
-{$IFDEF HAS_VARS} { DOS/DPMI/API CODE }
{---------------------------------------------------------------------------}
{ DOS/DPMI MOUSE INTERRUPT EVENT QUEUE SIZE }
{---------------------------------------------------------------------------}
CONST EventQSize = 16; { Default int bufsize }
-{$ENDIF}
{---------------------------------------------------------------------------}
{ DOS/DPMI/WIN/NT/OS2 NEW EVENT QUEUE MAX SIZE }
@@ -719,79 +595,10 @@ CONST QueueMax = 64; { Max new queue size }
{ PRIVATE INTERNAL TYPES }
{***************************************************************************}
-{$IFDEF OS_WINDOWS} { DOS/DPMI CODE }
-{---------------------------------------------------------------------------}
-{ SYBIL2+ WIN/NT COMPILER TYPE FIX UPS }
-{---------------------------------------------------------------------------}
- {$IFDEF PPC_SPEED} { SYBIL2+ COMPILER }
- TYPE TLogFont = LogFont; { Type fix up }
- TYPE TMsg = Msg; { Type fix up }
- TYPE TTextMetric = TextMetric; { Type fix up }
- {$ENDIF}
-{$ENDIF}
-
{***************************************************************************}
{ PRIVATE INTERNAL INITIALIZED VARIABLES }
{***************************************************************************}
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
-{---------------------------------------------------------------------------}
-{ DOS/DPMI INITIALIZED VARIABLES }
-{---------------------------------------------------------------------------}
- {$IFDEF GO32V2} { GO32V2 needs these }
- CONST
- RealSeg: Word = 0; { Real mode segment }
- RealOfs: Word = 0; { Real mode offset }
- MouseCallback: Pointer = Nil; { Mouse call back ptr }
- {$ENDIF}
-
-{$ENDIF}
-
-{$IFDEF OS_WINDOWS} { WIN/NT CODE }
-{---------------------------------------------------------------------------}
-{ WIN/NT TABLE OF ALT + ASCII CODES FROM VIRTUAL CODES }
-{---------------------------------------------------------------------------}
-CONST AltVirtualToAscii: Array [0..127] Of Word =
- ($00, $00, $00, $00, $00, $00, $00, $00,
- kbAltBack, kbAltTab, $00, $00, $00, kbEnter, $00, $00,
-{10H} $00, $00, $00, $00, $00, $00, $00, $00,
- $00, $00, $00, kbEsc, $00, $00, $00, $00,
-{20H} kbAltSpace, kbAltPgUp, kbAltPgDn, kbAltEnd, kbAltHome,
- kbAltLeft, kbAltUp, kbAltRight,
- kbAltDown, $00, $00, $00, $00, kbAltIns, kbAltDel, $00,
-{30H} kbAlt0, kbAlt1, kbAlt2, kbAlt3, kbAlt4, kbAlt5, kbAlt6, kbAlt7,
- kbAlt8, kbAlt9, $00, $00, $00, $00, $00, $00,
-{40H} $00, kbAltA, kbAltB, kbAltC, kbAltD, kbAltE, kbAltF, kbAltG,
- kbAltH, kbAltI, kbAltJ, kbAltK, kbAltL, kbAltM, kbAltN, kbAltO,
-{50H} kbAltP, kbAltQ, kbAltR, kbAltS, kbAltT, kbAltU, kbAltV, kbAltW,
- kbAltX, kbAltY, kbAltZ, $00, $00, $00, $00, $00,
-{60H} $00, $00, $00, $00, $00, $00, $00, $00,
- $00, $00, $372A, $4E2B, $00, $4A2D, $00, $352F,
-{70H} kbAltF1, kbAltF2, kbAltF3, kbAltF4, kbAltF5, kbAltF6, kbAltF7, kbAltF8,
- kbAltF9, kbAltF10, $00, $00, $00, $00, $00, $00);
-
-{---------------------------------------------------------------------------}
-{ WIN/NT TABLE OF WINDOWS ASCII TO INTERNATIONAL ASCII }
-{---------------------------------------------------------------------------}
-CONST WinAsciiToIntAscii: Array [128..255] Of Byte = (
-{80H} $00, $00, $00, $00, $00, $00, $00, $00,
- $00, $00, $00, $00, $00, $00, $00, $00,
-{90H} $00, $00, $00, $00, $00, $00, $00, $00,
- $00, $00, $00, $00, $00, $00, $00, $00,
-{A0H} $00, $AD, $BD, $9C, $CF, $BE, $B3, $F5,
- $00, $B8, $A6, $AE, $AA, $B0, $A9, $00,
-{B0H} $F8, $F1, $FD, $00, $EF, $E6, $F4, $00,
- $3C, $3E, $A7, $AF, $AC, $AB, $F3, $A8,
-{C0H} $B7, $B5, $B6, $C7, $8E, $8F, $92, $80,
- $D4, $90, $D2, $D3, $DE, $D6, $D7, $D8,
-{D0H} $D1, $A5, $E3, $E0, $E2, $E5, $99, $00,
- $9D, $EB, $E9, $EA, $9A, $ED, $E7, $E1,
-{E0H} $85, $A0, $83, $C6, $84, $86, $91, $87,
- $8A, $82, $88, $89, $8D, $A1, $8C, $8B,
-{F0H} $D0, $A4, $95, $A2, $93, $E4, $94, $F6,
- $9B, $97, $A3, $96, $81, $EC, $E8, $98);
-{$ENDIF}
-
{---------------------------------------------------------------------------}
{ DOS/DPMI/WIN/NT/OS2 ALT KEY SCANCODES FROM KEYS (0-127) }
{---------------------------------------------------------------------------}
@@ -830,7 +637,6 @@ CONST
{ PRIVATE INTERNAL UNINITIALIZED VARIABLES }
{***************************************************************************}
-{$ifdef Has_vars}
{---------------------------------------------------------------------------}
{ UNINITIALIZED DOS/DPMI/API VARIABLES }
{---------------------------------------------------------------------------}
@@ -853,23 +659,6 @@ VAR
EventQueue : Array [0..EventQSize - 1] Of TEvent; { Event queue }
EventQLast : RECORD END; { Simple end marker }
-{---------------------------------------------------------------------------}
-{ ABSOLUTE PRIVATE DOS/DPMI ADDRESS VARIABLES }
-{---------------------------------------------------------------------------}
- {$ifdef OS_DOS}
- {$IFNDEF GO32V1}
-VAR
- ShiftState: Byte Absolute $40:$17; { Shift state mask }
- Ticks: Word Absolute $40:$6C; { DOS tick counter }
- {$ENDIF}
- {$endif OS_DOS}
-
- {$IFDEF GO32V2} { GO32V2 registers }
-VAR
- ActionRegs: TRealRegs; { Real mode registers }
- {$ENDIF}
-
-{$ENDIF Has_Vars}
{---------------------------------------------------------------------------}
{ GetDosTicks (18.2 Hz) }
@@ -917,422 +706,6 @@ VAR
{ PRIVATE INTERNAL ROUTINES }
{***************************************************************************}
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-{ DOS/DPMI ONLY PRIVATE INTERNAL ROUTINES }
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
-
-{$IFDEF GO32V2} { GO32V2 CODE }
-{---------------------------------------------------------------------------}
-{ MouseTrap -> Platforms GO32V2 - FPC COMPILER Updated 10Sep98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE Mouse_Trap; FAR; ASSEMBLER;
-ASM
- PUSH %ES; { Save ES register }
- PUSH %DS; { Save DS register }
- PUSHL %EDI; { Save register }
- PUSHL %ESI; { Save register }
- ;{ caution : ds is not the selector for our data !! }
- PUSH %ES; { Push data seg }
- POP %DS; { Load data seg }
- PUSHL %EDI; { Actionregs address }
- MOVL MOUSECALLBACK, %EAX; { Fetch callback addr }
- CMPL $0, %EAX; { Check for nil ptr }
- JS .L_NoCallBack; { Ignore if nil }
- POPL %EAX; { %EAX = @actionregs }
- MOVL (%EAX), %EDI; { EDI from actionregs }
- MOVL 4(%EAX), %ESI; { ESI from actionregs }
- MOVL 16(%EAX), %EBX; { EBX from actionregs }
- MOVL 20(%EAX), %EDX; { EDX from actionregs }
- MOVL 24(%EAX), %ECX; { ECX from actionregs }
- MOVL 28(%EAX), %EAX; { EAX from actionregs }
- CALL *MOUSECALLBACK; { Call callback proc }
-.L_NoCallBack:
- POPL %ESI; { Recover register }
- POPL %EDI; { Recover register }
- POP %DS; { Restore DS register }
- POP %ES; { Restore ES register }
- MOVL (%ESI), %EAX;
- MOVL %EAX, %ES:42(%EDI); { Set as return addr }
- ADDW $4, %ES:46(%EDI); { adjust stack }
- IRET; { Interrupt return }
-END;
-{$ENDIF}
-
-{$IFDEF PPC_FPC} { FPC COMPILER CODE }
-{$ifndef Use_API}
-{---------------------------------------------------------------------------}
-{ Mouse_Action -> Platforms DPMI - FPC COMPILER Updated 10Sep98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE Mouse_Action (Mask : Integer; P : Pointer);
-VAR Error: Word; ErrStr: String; {$IFDEF GO32V2} Rg: TRealRegs; {$ENDIF}
-BEGIN
- {$IFDEF GO32V1} { GO32V1 CODE }
- ErrStr := 'GO32V1 mouse handler set failed !!'; { Set error string }
- ASM
- MOVL $0xFF, %EAX; { GO32v1 special id }
- MOVL P, %ECX; { Fuction to chain }
- MOVL $0x20, %EBX; { Event queue size > 0 }
- MOVL $0x12345678, %EDX; { Test for version ? }
- INT $0x33; { Call special wrapper }
- CMPW $0xFF0, %AX; { AX=$FF0 if success }
- JNZ .L_GO32V1Err;
- MOVW $0, %AX; { Zero register }
- JMP .LGO32V1Ok; { Now jump over }
- .L_GO32V1Err:
- MOVW $0xFFFF, %AX; { -1 to register }
- .L_GO32V1Ok:
- MOVW %AX, Error; { Set error result }
- END;
- {$ENDIF}
- {$IFDEF GO32V2} { GO32V2 CODE }
- Error := 0; { Preset no error }
- ErrStr := 'GO32V2 mouse handler set failed !!'; { Set error string }
- If (P <> MouseCallBack) Then Begin { Check func different }
- If (RealSeg <> 0) Then Begin { Remove old calback }
- Rg.AX := 12; { Function id }
- Rg.CX := 0; { Zero mask register }
- Rg.ES := 0; { Zero proc seg }
- Rg.DX := 0; { Zero proc ofs }
- RealIntr($33, Rg); { Stop INT 33 callback }
- ASM
- MOVW $0x304, %AX; { Set function id }
- MOVW REALSEG, %CX; { Bridged real seg }
- MOVW REALOFS, %DX; { Bridged real ofs }
- INT $0x31; { Release bridge }
- END;
- End;
- MouseCallback := P; { Set call back addr }
- If (P <> Nil) Then Begin { Check non nil proc }
- ASM
- LEAL ACTIONREGS, %EDI; { Addr of actionregs }
- LEAL MOUSE_TRAP, %ESI; { Procedure address }
- PUSH %DS; { Save DS segment }
- PUSH %ES; { Save ES segment }
- PUSH %DS;
- POP %ES; { ES now has dataseg }
- PUSH %CS;
- POP %DS; { DS now has codeseg }
- MOVW $0x303, %AX; { Function id }
- INT $0x31; { Call DPMI bridge }
- POP %ES; { Restore ES segment }
- POP %DS; { Restore DS segment }
- MOVW %CX, REALSEG; { Transfer real seg }
- MOVW %DX, REALOFS; { Transfer real ofs }
- MOVW $0, %AX; { Preset zero error }
- JNC .L_call_ok; { Branch if ok }
- MOVW $0xFFFF, %AX; { Force a -1 error }
- .L_call_ok:
- MOVW %AX, ERROR; { Return error state }
- END;
- Rg.CX := Mask; { Set mask register }
- End Else Begin
- Rg.EDI := 0; { Zero proc register }
- Rg.CX := 0; { Zero mask register }
- End;
- If (Error = 0) Then Begin { If no error }
- Rg.AX := 12; { Set function id }
- Rg.ES := RealSeg; { Real mode segment }
- Rg.DX := RealOfs; { Real mode offset }
- RealIntr($33, Rg); { Set interrupt 33 }
- End Else Begin
- RealSeg := 0; { Zero real mode seg }
- RealOfs := 0; { Zero real mode ofs }
- End;
- End;
- {$ENDIF}
- If (Error <> 0) Then Begin { Error encountered }
- WriteLn(ErrStr); { Write error }
- ReadLn; { Wait for user to see }
- End;
-END;
-
-{$ENDIF}
-
-{---------------------------------------------------------------------------}
-{ MouseInt -> Platforms DOS/DPMI - Updated 30Jun98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE MouseInt; FAR; ASSEMBLER;
-{$IFDEF ASM_BP} { BP COMPATABLE ASM }
-ASM
- MOV SI, SEG @DATA; { Fetch data segment }
- MOV DS, SI; { Fix data segment }
- MOV SI, CX; { Transfer x position }
- MOV MouseButtons, BL; { Update mouse buttons }
- MOV MouseWhere.X, SI; { Update x position }
- MOV MouseWhere.Y, DX; { Update y position }
- CMP EventCount, EventQSize; { Check if queue full }
- JZ @@QueueFull; { Queue is full exit }
- MOV ES, Seg0040; { Fetch DOS segment }
- MOV AX, ES:Ticks; { Fetch dos tick count }
- MOV DI, WORD PTR EventQTail; { Address of tail }
- PUSH DS; { Push to stack }
- POP ES; { ES to data segment }
- CLD; { Store forward }
- STOSW; { Store tick count }
- XCHG AX, BX; { Transfer register }
- STOSW; { Store button state }
- XCHG AX, SI; { Transfer register }
- STOSW; { Store x position }
- XCHG AX, DX; { Transfer register }
- STOSW; { Store y position }
- CMP DI, OFFSET EventQLast; { Roll if at queue end }
- JNE @@NoRollNeeded; { Not at queue end }
- MOV DI, OFFSET EventQueue; { Roll back to start }
-@@NoRollNeeded:
- MOV WORD PTR EventQTail, DI; { Update queue tail }
- INC EventCount; { One message added }
-@@QueueFull:
- MOV MouseIntFlag, 1; { Set interrupt flag }
- MOV SI, WORD PTR MouseMoveProc; { Low address word }
- OR SI, WORD PTR MouseMoveProc+2; { "OR" high word }
- JZ @@Exit; { No move call so exit }
- DB $66; PUSH AX; { Store EAX }
- DB $66; PUSH BX; { Store EBX }
- DB $66; PUSH CX; { Store ECX }
- DB $66; PUSH DX; { Store EDX }
- DB $66; PUSH SI; { Store ESI }
- DB $66; PUSH DI; { Store EDI }
- DB $66; PUSH BP; { Store EBP }
- PUSH ES; { Store ES }
- PUSH BP; { Standard BP push }
- MOV BP, SP; { Transfer stack ptr }
- CALL MouseMoveProc; { Standard procedure }
- POP BP; { Standard BP recover }
- POP ES; { Recover ES }
- DB $66; POP BP; { Recover EBP }
- DB $66; POP DI; { Recover EDI }
- DB $66; POP SI; { Recover ESI }
- DB $66; POP DX; { Recover EDX }
- DB $66; POP CX; { Recover ECX }
- DB $66; POP BX; { Recover EBX }
- DB $66; POP AX; { Recover EAX }
-@@Exit:
-END;
-{$ENDIF}
-{$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
-ASM
- MOVW %CX, %SI; { Transfer x position }
- MOVB %BL, MOUSEBUTTONS; { Update mouse buttons }
- MOVW %SI, MOUSEWHERE; { Update x position }
- MOVW %DX, MOUSEWHERE+2; { Update y position }
- CMPW $16, EVENTCOUNT; { Check if queue full }
- JZ .L_QueueFull; { Queue is full exit }
- PUSH %ES; { Save segment }
- MOVW $0x40, %AX; { Fetch DOS segment }
- MOVW %AX, %ES; { Transfer to segment }
- MOVL $0x6C, %EDI; { Address of ticks }
- MOVW %ES:(%EDI), %AX; { Fetch dos tick count }
- POP %ES; { Recover segment }
- MOVL EVENTQTAIL, %EDI; { Queue tail address }
- CLD; { Store forward }
- STOSW; { Store tick count }
- XCHGW %BX, %AX; { Transfer register }
- STOSW; { Store button state }
- XCHGW %SI, %AX; { Transfer register }
- STOSW; { Store x position }
- XCHGW %DX, %AX; { Transfer register }
- STOSW; { Store y position }
- LEAL EVENTQLAST, %EAX; { Roll point address }
- CMPL %EAX, %EDI; { Roll if at queue end }
- JNE .L_NoRollNeeded; { Not at queue end }
- LEAL EVENTQUEUE, %EDI; { Roll back to start }
-.L_NoRollNeeded:
- MOVL %EDI, EVENTQTAIL; { Update queue tail }
- INCW EVENTCOUNT; { One message added }
-.L_QueueFull:
- MOVB $1, MOUSEINTFLAG; { Set interrupt flag }
- MOVL MOUSEMOVEPROC, %EAX; { Load proc address }
- CMPL $0, %EAX; { Check for nil ptr }
- JZ .L_Exit; { No move call so exit }
- PUSHL %EAX; { Store EAX }
- PUSHL %EBX; { Store EBX }
- PUSHL %ECX; { Store ECX }
- PUSHL %EDX; { Store EDX }
- PUSHL %ESI; { Store ESI }
- PUSHL %EDI; { Store EDI }
- PUSHL %EBP; { Store EBP }
- PUSH %ES; { Store ES }
- CALL %EAX; { Standard procedure }
- POP %ES; { Recover ES }
- POPL %EBP; { Recover EBP }
- POPL %EDI; { Recover EDI }
- POPL %ESI; { Recover ESI }
- POPL %EDX; { Recover EDX }
- POPL %ECX; { Recover ECX }
- POPL %EBX; { Recover EBX }
- POPL %EAX; { Recover EAX }
-.L_Exit:
-END;
-{$ENDIF}
-{$endif not Use_API}
-
-{---------------------------------------------------------------------------}
-{ HideMouseCursor -> Platforms DOS/DPMI - Updated 10Sep98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE HideMouseCursor; ASSEMBLER;
-{$IFDEF ASM_BP} { BP COMPATABLE ASM }
-ASM
- CMP MouseEvents, 0; { Check mouse system }
- JZ @@Exit; { Branch if not active }
- MOV AX, WORD PTR [HideMouseProc]; { Fetch offset of addr }
- OR AX, WORD PTR [HideMouseProc+2]; { Check for nil ptr }
- JZ @@UseMouseInt; { Branch if nil }
- CALL FAR PTR [HideMouseProc]; { Call hide mouse }
- JMP @@Exit; { Now exit }
-@@UseMouseInt:
- MOV AX, $2; { Load function id }
- PUSH BP; { Safety!! save reg }
- INT $33; { Hide the mouse }
- POP BP; { Restore register }
-@@Exit:
-END;
-{$ENDIF}
-{$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
-ASM
- CMPB $0, MouseEvents; { Check mouse system }
- JZ .L_Exit; { Branch if not active }
- MOVL HideMouseProc, %EAX; { Fetch address }
- ORL %EAX, %EAX; { Check for nil ptr }
- JZ .L_UseMouseInt; { Branch if nil }
- CALL HideMouseProc; { Call show mouse }
- JMP .L_Exit; { Now exit }
-.L_UseMouseInt:
- MOVW $2, %AX; { Load function id }
- PUSHL %EBP; { Save regigister }
- INT $0x33; { Hide the mouse }
- POPL %EBP; { Restore register }
-.L_Exit:
-END;
-{$ENDIF}
-
-{---------------------------------------------------------------------------}
-{ ShowMouseCursor -> Platforms DOS/DPMI - Updated 10Sep98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE ShowMouseCursor; ASSEMBLER;
-{$IFDEF ASM_BP} { BP COMPATABLE ASM }
-ASM
- CMP MouseEvents, 0; { Check mouse system }
- JZ @@Exit; { Branch if not active }
- MOV AX, WORD PTR [ShowMouseProc]; { Fetch offset of addr }
- OR AX, WORD PTR [ShowMouseProc+2]; { Check for nil ptr }
- JZ @@UseMouseInt; { Branch if nil }
- CALL FAR PTR [ShowMouseProc]; { Call show mouse }
- JMP @@Exit; { Now exit }
-@@UseMouseInt:
- MOV AX, $1; { Load function id }
- PUSH BP; { Safety!! save reg }
- INT $33; { Show the mouse }
- POP BP; { Restore register }
-@@Exit:
-END;
-{$ENDIF}
-{$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
-ASM
- CMPB $0, MouseEvents; { Check mouse system }
- JZ .L_Exit; { Branch if not active }
- MOVL ShowMouseProc, %EAX; { Fetch address }
- ORL %EAX, %EAX; { Check for nil ptr }
- JZ .L_UseMouseInt; { Branch if nil }
- CALL ShowMouseProc; { Call show mouse }
- JMP .L_Exit; { Now exit }
-.L_UseMouseInt:
- MOVW $1, %AX; { Load function id }
- PUSHL %EBP; { Save regigister }
- INT $0x33; { Hide the mouse }
- POPL %EBP; { Restore register }
-.L_Exit:
-END;
-{$ENDIF}
-
-
-{$ifndef Use_API}
-{---------------------------------------------------------------------------}
-{ HookMouse -> Platforms DOS/DPMI - Updated 27Aug98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE HookMouse;
-BEGIN
- {$IFDEF ASM_BP} { BP COMPTABABLE ASM }
- ASM
- MOV AX, $000C; { Set user interrupt }
- MOV CX, $FFFF; { For all event masks }
- MOV DX, OFFSET CS:MouseInt; { Mouse int is hook }
- PUSH CS; { Push code segment }
- POP ES; { ES:DX -> MouseInt }
- PUSH BP; { Safety!! save reg }
- INT $33; { Hook the routine }
- POP BP; { Restore register }
- END;
- {$ENDIF}
- {$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
- {$IFDEF GO32V2} { GO32V2 CODE }
- Lock_Code(Pointer(@Mouse_Trap), 400); { Lock trap code }
- Lock_Data(ActionRegs, SizeOf(ActionRegs)); { Lock registers }
- {$ENDIF}
- Mouse_Action(-1, @MouseInt); { Set masks/interrupt }
- {$ENDIF}
-END;
-
-
-{---------------------------------------------------------------------------}
-{ UnHookMouse -> Platforms DOS/DPMI - Updated 27Aug98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE UnHookMouse;
-BEGIN
- {$IFDEF ASM_BP} { BP COMPATABLE ASM }
- ASM
- MOV AX, $000C; { Set user interrupt }
- XOR CX, CX; { Clear all masks }
- XOR DX, DX; { Clear register }
- MOV ES, CX; { ES:DX -> Nil }
- PUSH BP; { Safety!! save reg }
- INT $33; { Release mouse hook }
- POP BP; { Restore register }
- END;
- {$ENDIF}
- {$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
- Mouse_Action(0, Nil); { Clear mask/interrupt }
- {$IFDEF GO32V2} { GO32V2 CODE }
- Unlock_Code(Pointer(@Mouse_Trap), 400); { Release trap code }
- Unlock_Data(ActionRegs, SizeOf(TRealRegs)); { Release registers }
- {$ENDIF}
- {$ENDIF}
-END;
-
-{---------------------------------------------------------------------------}
-{ GetMousePosition -> Platforms DOS/DPMI - Updated 19May98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE GetMousePosition (Var X, Y: sw_Integer); ASSEMBLER;
-{$IFDEF ASM_BP} { BP COMPATABLE ASM }
-ASM
- MOV AX, $3; { Set function id }
- PUSH BP; { Safety!! save reg }
- INT $33; { Get button data }
- POP BP; { Restore register }
- LES DI, X; { Adress of x }
- MOV ES:[DI], CX; { Return x position }
- LES DI, Y; { Adress of y }
- MOV ES:[DI], DX; { Return y position }
-END;
-{$ENDIF}
-{$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
-ASM
- MOVW $3, %AX; { Set function id }
- PUSHL %EBP; { Save register }
- INT $0x33; { Get button data }
- POPL %EBP; { Restore register }
- MOVL X, %EDI; { Adress of x }
- MOVW %CX, (%EDI); { Return x position }
- MOVL Y, %EDI; { Adress of y }
- MOVW %DX, (%EDI); { Return y position }
-END;
-{$ENDIF}
-{$endif not Use_API}
-
-{$ENDIF}
-
-{$IFDEF USE_API}
-{$IFNDEF OS_DOS}
PROCEDURE ShowMouseCursor;
BEGIN
ShowMouse;
@@ -1343,9 +716,6 @@ BEGIN
HideMouse;
END;
-{$ENDIF not OS_DOS}
-{$ENDIF USE_API}
-
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ DOS/DPMI/WIN/NT/OS2 PRIVATE INTERNAL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -1357,10 +727,8 @@ PROCEDURE ExitDrivers; {$IFNDEF OS_LINUX} FAR; {$ENDIF}
BEGIN
DoneSysError; { Relase error trap }
DoneEvents; { Close event driver }
-{$ifdef Use_API}
DoneKeyboard;
DoneVideo;
-{$endif Use_API}
ExitProc := SaveExit; { Restore old exit }
END;
@@ -1481,70 +849,10 @@ END;
{---------------------------------------------------------------------------}
{ DetectMouse -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB }
-{$ifdef Use_API}
FUNCTION DetectMouse: Byte;
begin
DetectMouse:=Mouse.DetectMouse;
end;
-{$else not Use_API}
-{---------------------------------------------------------------------------}
-FUNCTION DetectMouse: Byte;
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
- {$IFDEF ASM_BP} { BP COMPATABLE ASM }
- ASSEMBLER;
- ASM
- MOV AX, $3533; { Set function id }
- PUSH BP; { Safety!! save reg }
- INT $21; { Get mouse interrupt }
- POP BP; { Restore register }
- MOV AX, ES; { Transfer register }
- OR AX, BX; { Check for nil ptr }
- JZ @@Exit2; { Jump no mouse driver }
- XOR AX, AX; { Set function id }
- PUSH BP; { Safety!! save reg }
- INT $33; { Reset mouse }
- POP BP; { Restore register }
- OR AX, AX; { Check for success }
- JZ @@Exit2; { Reset mouse failed }
- MOV AX, BX; { Return button count }
- @@Exit2:
- END;
- {$ENDIF}
- {$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
- ASSEMBLER;
- ASM
- MOVW $0x200, %AX; { Get real mode int }
- MOVW $0x33, %BX; { Vector 33H }
- PUSHL %EBP; { Save register }
- INT $0x31; { Get the address }
- POPL %EBP; { Restore register }
- MOVW %CX, %AX; { Transfer register }
- ORW %DX, %AX; { Check for nil ptr }
- JZ .L_Exit2; { Jump no mouse driver }
- XORW %AX, %AX; { Set function id }
- PUSHL %EBP; { Save register }
- INT $0x33; { Reset mouse driver }
- POPL %EBP; { Restore register }
- ORW %AX, %AX; { Check for success }
- JZ .L_Exit2; { Reset mouse failed }
- MOVW %BX, %AX; { Return button count }
- .L_Exit2:
- END;
- {$ENDIF}
-{$ENDIF}
-{$IFDEF OS_WINDOWS} { WIN/NT CODE }
-BEGIN
- If (GetSystemMetrics(sm_MousePresent) <> 0) Then
- DetectMouse := 2 Else DetectMouse := 0; { Buttons present }
-END;
-{$ENDIF}
-{$IFDEF OS_OS2} { OS2 CODE }
-BEGIN
- DetectMouse := WinQuerySysValue(HWND_Desktop,
- SV_CMouseButtons); { Buttons present }
-END;
-{$ENDIF}
-{$endif not Use_API}
{***************************************************************************}
{ INTERFACE ROUTINES }
@@ -1703,7 +1011,6 @@ BEGIN
End;
END;
-{$ifdef Use_API}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ KEYBOARD CONTROL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -1856,604 +1163,6 @@ begin
FillChar(Event,sizeof(TEvent),0);
end;
-{$else not Use_API}
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-{ KEYBOARD CONTROL ROUTINES }
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-
-{---------------------------------------------------------------------------}
-{ GetShiftState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Jul96 LdB }
-{---------------------------------------------------------------------------}
-FUNCTION GetShiftState: Byte;
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
- {$IFDEF ASM_BP} { BP COMPATABLE ASM }
- ASSEMBLER;
- ASM
- MOV ES, Seg0040; { Load DOS segment }
- XOR AX, AX;
- MOV DX, AX; { Clear registers }
- MOV AL, ES:[$0017]; { Read shift state }
- END;
- {$ENDIF}
- {$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
- BEGIN
- ASM
- MOVW $0x0200, %AX; { Set function id }
- PUSHL %EBP; { Save register }
- INT $0x16; { Get shift status }
- POPL %EBP; { Restore register }
- END;
- END;
- {$ENDIF}
-{$ENDIF}
-{$IFDEF OS_WINDOWS} { WIN/NT CODE }
-CONST vk_Scroll = $91; { Borland forgot this! }
-VAR B: Byte;
-BEGIN
- B := 0; { Clear all masks }
- If (GetKeyState(vk_Shift) AND $80 <> 0) Then
- B := B OR kbBothShifts; { Set both shifts }
- If (GetKeyState(vk_Control) AND $80 <> 0) Then
- B := B OR kbCtrlShift; { Set control mask }
- If (GetKeyState(vk_Menu) AND $80 <> 0) Then
- B := B OR kbAltShift; { Set alt mask }
- If (GetKeyState(vk_Scroll) AND $81 <> 0) Then
- B := B OR kbScrollState; { Set scroll lock mask }
- If (GetKeyState(vk_NumLock) AND $81 <> 0) Then
- B := B OR kbNumState; { Set number lock mask }
- If (GetKeyState(vk_Capital) AND $81 <> 0) Then
- B := B OR kbCapsState; { Set caps lock mask }
- If (GetKeyState(vk_Insert) AND $81 <> 0) Then
- B := B OR kbInsState; { Set insert mask }
- GetShiftState := B; { Return masks }
-END;
-{$ENDIF}
-{$IFDEF OS_OS2} { OS2 CODE }
-VAR Key: KbdInfo;
-BEGIN
- Key.cb := SizeOf(Key); { Keyboard size }
- If KbdGetStatus(Key, 0) = 0 Then { Get key status }
- GetShiftState := Key.fsState Else { Return shift state }
- GetShiftState := 0; { Failed so return 0 }
-END;
-{$ENDIF}
-
-{---------------------------------------------------------------------------}
-{ GetKeyEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE GetKeyEvent (Var Event: TEvent);
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
-ASSEMBLER;
- {$IFDEF ASM_BP} { BP COMPATABLE ASM }
- ASM
- MOV AH, $1; { Set function id }
- PUSH BP; { Safety!! save reg }
- INT $16; { Check for keypress }
- POP BP; { Restore register }
- MOV AX, $0; { Zero register AX }
- MOV BX, AX; { Zero register BX }
- JZ @@Exit3; { No keypress jump }
- MOV AH, $00; { Set function id }
- PUSH BP; { Safety!! save reg }
- INT $16; { Read the key }
- POP BP; { Restore register }
- XCHG AX, BX; { Exchange registers }
- MOV AX, evKeyDown; { Set keydown event }
- @@Exit3:
- LES DI, Event; { ES:DI -> Event }
- MOV ES:[DI].TEvent.What, AX; { Store event mask }
- MOV ES:[DI].TEvent.KeyCode, BX; { Store key code }
- END;
- {$ENDIF}
- {$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
- ASM
- MOVB $1, %AH; { Set function id }
- PUSHL %EBP; { Save register }
- INT $0x16; { Check for keypress }
- POPL %EBP; { Restore register }
- MOVW $0x0, %AX; { Zero register AX }
- MOVW %AX, %BX; { Zero register BX }
- JZ .L_Exit3; { No keypress jump }
- MOVB $0, %AH; { Set function id }
- PUSHL %EBP; { Save register }
- INT $0x16; { Read the key }
- POPL %EBP; { Restore register }
- XCHGW %BX, %AX; { Exchange registers }
- MOVW $0x10, %AX; { Set keydown event }
- .L_Exit3:
- MOVL Event, %EDI; { EDI -> Event }
- CLD;
- STOSW; { Store event mask }
- XCHGW %BX, %AX; { Transfer key code }
- STOSW; { Store key code }
- END;
- {$ENDIF}
-{$ENDIF}
-{$IFDEF OS_WINDOWS} { WIN/NT CODE }
-CONST NumPos: Byte = 0; Numeric: Byte = 0;
-VAR Handled: Boolean; B: Byte; Msg: TMsg;
-BEGIN
- Event.What := evNothing; { Preset no event }
- {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
- If (PeekMessage(@Msg, 0, 0, WM_MouseFirst-1, pm_Remove)
- OR PeekMessage(@Msg, 0, WM_MouseLast+1, $FFFF, pm_Remove))
- {$ELSE} { OTHER COMPILERS }
- If (PeekMessage(Msg, 0, 0, WM_MouseFirst-1, pm_Remove)
- OR PeekMessage(Msg, 0, WM_MouseLast+1, $FFFF, pm_Remove))
- {$ENDIF}
- Then Begin { Non mouse message }
- Handled := False; { Preset not handled }
- Case Msg.Message Of
- WM_Char: Begin { CHARACTER KEY }
- NumPos := 0; { Zero number position }
- Event.CharCode := Char(Msg.wParam); { Transfer character }
- If (Event.CharCode > #127) Then
- Event.CharCode := Chr(WinAsciiToIntAscii[
- Ord(Event.CharCode)]); { Convert to ascii }
- Event.ScanCode := Lo(HiWord(Msg.lParam)); { Transfer scan code }
- If (Event.CharCode <> #0) Then Begin { If valid key then }
- Event.What := evKeyDown; { Key down event }
- Handled := True; { Message was handled }
- If (Event.KeyCode = kbTab) AND { Tab key is special }
- (GetShiftState AND kbBothShifts <> 0) Then { Check shift state }
- Event.KeyCode := kbShiftTab; { If set make shifttab }
- End;
- End;
- WM_SysKeyDown: Begin { SYSTEM KEY DOWN }
- If (NumPos > 0) Then Begin { Numerics entry op }
- Case Msg.wParam Of
- VK_Insert: Begin { Insert key }
- If (GetShiftState AND kbAltShift <> 0) { Alt key down }
- Then Begin
- Event.What := evKeyDown; { Key down event }
- Event.KeyCode := kbAltIns; { Alt + Ins key }
- Handled := True; { Set key handled }
- Exit; { Now exit }
- End;
- B := 0; { Key value = 0 }
- End;
- VK_End: B := 1; { Key value = 1 }
- VK_Down: B := 2; { Key value = 2 }
- VK_Next: B := 3; { Key value = 3 }
- VK_Left: B := 4; { Key value = 4 }
- VK_Clear: B := 5; { Key value = 5 }
- VK_Right: B := 6; { Key value = 6 }
- VK_Home: B := 7; { Key value = 7 }
- VK_Up: B := 8; { Key value = 8 }
- VK_Prior: B := 9; { Key value = 9 }
- VK_NumPad0..VK_NumPad9: B := Msg.wParam
- - $60; { Numbic key pad }
- Else NumPos := 0; { Invalid key }
- End;
- If ((NumPos > 0) AND (NumPos < 4)) AND { Valid position }
- ((B >= $0) AND (B <= $9)) Then Begin { Valid key }
- Numeric := Numeric*10 + B; { Adjust numeric }
- Inc(NumPos); { Next position }
- If (NumPos = 4) Then Begin { We have three keys }
- Event.What := evKeyDown; { Set keydown event }
- Event.CharCode := Chr(Numeric); { Transfer code }
- NumPos := 0; { Zero number position }
- End;
- Handled := True; { Message was handled }
- End Else NumPos := 0; { Zero number position }
- End;
- If (Msg.WParam = vk_Menu) Then Begin { ALT key down }
- Numeric := 0; { Zero numeric }
- NumPos := 1; { Set to start point }
- Handled := True; { Message was handled }
- End;
- If NOT Handled Then Begin { Key press not handled }
- If (Lo(Msg.wParam) < 128) Then Begin { Ignore if above 128 }
- If (Msg.wParam = vk_F10) Then Begin { F10 reports oddly }
- If (GetKeyState(vk_Shift) AND $80 <> 0)
- Then Event.KeyCode := kbShiftF10 Else{ Shift F10 }
- If (GetKeyState(vk_Menu) AND $80 <> 0)
- Then Event.KeyCode := kbAltF10 Else { Alt F10 }
- If (GetKeyState(vk_Control) AND $80 <> 0)
- Then Event.KeyCode := kbCtrlF10 { Ctrl F10 }
- Else Event.KeyCode := kbF10; { Normal F10 }
- End Else Event.KeyCode :=
- AltVirtualToAscii[Lo(Msg.wParam)]; { Convert key code }
- End Else Event.KeyCode := 0; { Clear Event.keycode }
- If (Event.KeyCode <> 0) Then Begin { If valid key then }
- Event.What := evKeyDown; { Key down event }
- Handled := True; { Message was handled }
- End;
- End;
- End;
- WM_KeyDown: Begin { ARROWS/F1..F12 KEYS }
- If (((Msg.WParam >= Vk_F1) AND (Msg.WParam <= Vk_F12)) OR
- ((Msg.WParam >= Vk_Prior) AND (Msg.WParam <= Vk_Delete)))
- Then Begin { Special key press }
- Event.CharCode := #0; { Clear char code }
- Event.ScanCode := Lo(HiWord(Msg.LParam)); { Create scan code }
- If (GetKeyState(vk_Shift) AND $80 <> 0)
- Then Begin { Shift key down }
- Case Msg.wParam Of
- vk_F1..vk_F9: Event.KeyCode :=
- Event.KeyCode + $1900; { Shift F1..F9 keys }
- vk_F11: Event.KeyCode := kbShiftF11; { Shift F11 key }
- vk_F12: Event.KeyCode := kbShiftF12; { Shift F12 key }
- End;
- End Else If (GetKeyState(vk_Control) AND $80 <> 0)
- Then Begin { Control key down }
- Case Msg.wParam Of
- vk_F1..vk_F9: Event.KeyCode :=
- Event.KeyCode + $2300; { Ctrl F1..F9 keys }
- vk_F11: Event.KeyCode := kbCtrlF11; { Ctrl F11 key }
- vk_F12: Event.KeyCode := kbCtrlF12; { Ctrl F12 key }
- End;
- End;
- If (Event.KeyCode <> 0) Then Begin { If valid key then }
- Event.What := evKeyDown; { Key down event }
- Handled := True; { Message was handled }
- End;
- End;
- NumPos := 0; { Zero number position }
- End;
- End;
- If NOT Handled Then Begin { Check we did not handle }
- TranslateMessage(Msg); { Translate message }
- DispatchMessage(Msg); { Dispatch message }
- End;
- End;
-END;
-{$ENDIF}
-{$IFDEF OS_OS2} { OS2 CODE }
-VAR Msg: QMsg;
-BEGIN
- Event.What := evNothing; { Preset no event }
- If (WinPeekMsg(Anchor, Msg, 0, 0, WM_MouseFirst-1, pm_Remove)
- OR WinPeekMsg(Anchor, Msg, 0, WM_MouseLast+1, $FFFFFFFF, pm_Remove))
- Then Begin { Check for message }
- If (Msg.Msg = WM_Char) AND { Character message }
- (Msg.Mp1 AND KC_KeyUp <> 0) AND { Key released }
- (Msg.Mp1 AND KC_Composite = 0) { Not composite key }
- Then Begin
- If (Short1FromMP(Msg.Mp1) AND KC_ScanCode <> 0 )
- Then Begin
- Event.ScanCode := Ord(Char4FromMP(Msg.Mp1)); { Return scan code }
- Event.CharCode := Char1FromMP(Msg.Mp2); { Return char code }
- If (Event.CharCode = Chr($E0)) Then Begin
- Event.CharCode := #0;
- Event.ScanCode := Byte(Char2FromMP(Msg.Mp2));
- End;
- If (Event.KeyCode <> 0) Then
- Event.What := evKeyDown; { Key down event }
- End;
- End;
- If (Event.What = evNothing) Then { Event not handled }
- WinDispatchMsg(Anchor, Msg); { Disptach message }
- End;
-END;
-{$ENDIF}
-
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-{ MOUSE CONTROL ROUTINES }
-{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-
-{---------------------------------------------------------------------------}
-{ HideMouse -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jun98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE HideMouse;
-BEGIN
- If (HideCount = 0) Then Begin { Is mouse hidden yet? }
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
- HideMouseCursor; { Hide mouse cursor }
- {$ENDIF}
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- ShowCursor(False); { Hide mouse cursor }
- {$ENDIF}
- {$IFDEF OS_OS2} { OS2 CODE }
- If (AppWindow <> 0) Then { Window valid }
- WinShowCursor(AppWindow, False); { Hide mouse cursor }
- {$ENDIF}
- End;
- Inc(HideCount); { Inc hide count }
-END;
-
-{---------------------------------------------------------------------------}
-{ ShowMouse -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jun98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE ShowMouse;
-BEGIN
- Dec(HideCount); { Dec hide count }
- If (HideCount = 0) Then Begin { Is mouse visible? }
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
- ShowMouseCursor; { Show mouse cursor }
- {$ENDIF}
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- ShowCursor(True); { Show mouse cursor }
- {$ENDIF}
- {$IFDEF OS_OS2} { OS2 CODE }
- If (AppWindow <> 0) Then { Window valid }
- WinShowCursor(AppWindow, True); { Show mouse cursor }
- {$ENDIF}
- End;
-END;
-
-{---------------------------------------------------------------------------}
-{ GetMouseEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 09Sep98 LdB }
-{---------------------------------------------------------------------------}
-PROCEDURE GetMouseEvent (Var Event: TEvent);
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
-ASSEMBLER;
- {$IFDEF ASM_BP} { BP COMPATABLE ASM }
-ASM
- CMP MouseEvents, 0; { Any mouse events }
- JNZ @@MouseOk; { Check mouse active }
- JMP @@NoEventExit; { Mouse not active }
-@@MouseOk:
- CLI; { Disable interrupts }
- CMP EventCount, 0; { Check event count }
- JNE @@MouseEventInQueue; { If > 0 event avail }
- MOV BL, MouseButtons; { Fetch mouse buttons }
- MOV CX, MouseWhere.Word[0]; { Fetch mouse where.x }
- MOV DX, MouseWhere.Word[2]; { Fetch mouse where.y }
- MOV ES, Seg0040; { DOS DAT SEG }
- MOV DI, ES:Ticks; { Fetch current time }
- JMP @@NextMsgReady; { Now process }
-@@MouseEventInQueue:
- MOV SI, WORD PTR EventQHead; { Event queue head }
- CLD; { Direction forward }
- LODSW; { Fetch word 1 }
- XCHG AX, DI; { Set timer ticks }
- LODSW; { Fetch word 2 }
- XCHG AX, BX; { Set button masks }
- LODSW; { Fetch word 3 }
- XCHG AX, CX; { Set mouse x position }
- LODSW; { Fetch word 4 }
- XCHG AX, DX; { Set mouse y position }
- CMP SI, OFFSET EventQLast; { Check if roll needed }
- JNE @@NoRoll;
- MOV SI, OFFSET EventQueue; { Roll back to start }
-@@NoRoll:
- MOV WORD PTR EventQHead, SI; { Update queue head }
- DEC EventCount; { One event cleared }
-@@NextMsgReady:
- STI; { Enable interrupts }
- CMP MouseReverse, 0; { Check mouse reversed }
- JE @@MouseNormal;
- MOV BH, BL; { Transfer button mask }
- AND BH, 3; { Clear others masks }
- JE @@MouseNormal; { Neither set exit }
- CMP BH, 3; { Check not all set }
- JE @@MouseNormal; { Both set exit }
- XOR BL, 3; { Invert button masks }
-@@MouseNormal:
- MOV BH, [LastDouble]; { Load last double }
- MOV AL, [LastButtons]; { Load last buttons }
- CMP AL, BL; { Are buttons same? }
- JE @@SameButtonsDown;
- OR AL, AL; { Any last buttons? }
- JE @@ButtonsDown;
- OR BL, BL; { Any buttons down? }
- JE @@MouseUp;
- MOV BL, AL; { Transfer new buttons }
-@@SameButtonsDown:
- CMP CX, [LastWhereX]; { Mouse moved from x }
- JNE @@MouseMove;
- CMP DX, [LastWhereY]; { Mouse moved from y }
- JNE @@MouseMove;
- OR BL, BL; { Any buttons pressed? }
- JE @@NoButtonsDown;
- MOV AX, DI; { Current tick count }
- SUB AX, [AutoTicks]; { Subtract last count }
- CMP AX, [AutoDelay]; { Greater than delay? }
- JAE @@MouseAuto; { Mouse auto event }
-@@NoButtonsDown:
- JMP @@NoEventExit; { No event exit }
-@@ButtonsDown:
- MOV BH, 0; { Preset no dbl click }
- CMP BL, [DownButtons]; { Check to last down }
- JNE @@MouseDown;
- CMP CX, [DownWhereX]; { Check x position }
- JNE @@MouseDown;
- CMP DX, [DownWhereY]; { Check y position }
- JNE @@MouseDown;
- MOV AX, DI; { Transfer tick count }
- SUB AX, [DownTicks]; { Sub last down count }
- CMP AX, [DoubleDelay]; { Greater than delay? }
- JAE @@MouseDown;
- MOV BH, 1; { Double click }
-@@MouseDown:
- MOV [DownButtons], BL; { Hold down buttons }
- MOV [DownWhereX], CX; { Hold x down point }
- MOV [DownWhereY], DX; { Hold y down point }
- MOV [DownTicks], DI; { Hold tick value }
- MOV [AutoTicks], DI; { Hold tick value }
- MOV AX, [RepeatDelay]; { Load delay count }
- MOV [AutoDelay], AX; { Set delay time }
- MOV AX, evMouseDown; { Mouse down event }
- JMP @@UpdateValues; { Update, svae & exit }
-@@MouseUp:
- MOV AX, evMouseUp; { Mouse button up }
- JMP @@UpdateValues; { Update, save & exit }
-@@MouseMove:
- MOV AX, evMouseMove; { Mouse has moved }
- JMP @@UpdateValues; { Update, save & exit }
-@@MouseAuto:
- MOV AX, evMouseAuto; { Mouse auto event }
- MOV [AutoTicks], DI; { Reset auto ticks }
- MOV [AutoDelay], 1; { Reset delay count }
-@@UpdateValues:
- MOV [LastButtons], BL; { Save last buttons }
- MOV [LastDouble], BH; { Save double state }
- MOV [LastWhereX], CX; { Save x position }
- MOV [LastWhereY], DX; { Save y position }
- JMP @@StoreAndExit; { Now store and exit }
-@@NoEventExit:
- XOR AX, AX; { Clear register }
- MOV BX, AX; { Clear register }
- MOV CX, AX; { Clear register }
- MOV DX, AX; { Clear register }
-@@StoreAndExit:
- LES DI, Event; { Address of event }
- CLD; { Set direction fwd }
- STOSW; { Save 1st word }
- XCHG AX, BX; { Transfer register }
- STOSW; { Save 2nd word }
- XCHG AX, CX; { Transfer register }
- STOSW; { Save 3rd word }
- XCHG AX, DX; { Transfer register }
- STOSW; { Save 4th word }
-END;
- {$ENDIF}
- {$IFDEF ASM_FPC} { FPC COMPATABLE ASM }
-ASM
- CMPB $0, MOUSEEVENTS; { Any mouse events }
- JNZ .L_MouseOk; { Check mouse active }
- JMP .L_NoEventExit; { Mouse not active }
-.L_MouseOk:
- CLI;
- CMPW $0, EVENTCOUNT; { Check event count }
- JNE .L_MouseEventInQueue; { If > 0 event avail }
- MOVB MOUSEBUTTONS, %BL; { Fetch mouse buttons }
- MOVW MOUSEWHERE, %CX; { Fetch mouse where.x }
- MOVW MOUSEWHERE+2, %DX; { Fetch mouse where.y }
- PUSH %ES; { Save segment }
- MOVW $0x40, %AX; { Fetch DOS segment }
- MOVW %AX, %ES; { Transfer to segment }
- MOVL $0x6C, %EDI; { Tick address }
- MOVW %ES:(%EDI), %DI; { Fetch dos tick count }
- POP %ES; { Recover segment }
- JMP .L_NextMsgReady; { Now process }
-.L_MouseEventInQueue:
- MOVL EVENTQHEAD, %ESI; { Event queue head }
- CLD; { Direction forward }
- LODSW; { Fetch word 1 }
- XCHGW %DI, %AX; { Set timer ticks }
- LODSW; { Fetch word 2 }
- XCHGW %BX, %AX; { Set button masks }
- LODSW; { Fetch word 3 }
- XCHGW %CX, %AX; { Set mouse x position }
- LODSW; { Fetch word 4 }
- XCHGW %DX, %AX; { Set mouse y position }
- LEAL EVENTQLAST, %EAX; { Address of roll pt }
- CMPL %EAX, %ESI; { Check if roll needed }
- JNE .L_NoHeadRoll;
- LEAL EVENTQUEUE, %ESI; { Roll back to start }
-.L_NoHeadRoll:
- MOVL %ESI, EVENTQHEAD; { Update queue head }
- DECW EVENTCOUNT; { One event cleared }
-.L_NextMsgReady:
- STI; { Enable interrupts }
- CMPB $0, MOUSEREVERSE; { Check mouse reversed }
- JE .L_MouseNormal;
- MOVB %BL, %BH; { Transfer button mask }
- ANDB $3, %BH; { Clear others masks }
- JE .L_MouseNormal; { Neither set exit }
- CMPB $3, %BH; { Check not all set }
- JE .L_MouseNormal; { Both set exit }
- XORB $3, %BL; { Invert button masks }
-.L_MouseNormal:
- MOVB LASTDOUBLE, %BH; { Load last double }
- MOVB LASTBUTTONS, %AL; { Load last buttons }
- CMPB %BL, %AL; { Are buttons same? }
- JE .L_SameButtonsDown;
- ORB %AL, %AL; { Any last buttons? }
- JE .L_ButtonsDown;
- ORB %BL, %BL; { Any buttons down? }
- JE .L_MouseUp;
- MOVB %AL, %BL; { Transfer new buttons }
-.L_SameButtonsDown:
- CMPW LASTWHEREX, %CX; { Mouse moved from x }
- JNE .L_MouseMove;
- CMPW LASTWHEREY, %DX; { Mouse moved from y }
- JNE .L_MouseMove;
- ORB %BL, %BL; { Any buttons pressed? }
- JE .L_NoButtonsDown;
- MOVW %DI, %AX; { Current tick count }
- SUBW AUTOTICKS, %AX; { Subtract last count }
- CMPW AUTODELAY, %AX; { Greater than delay? }
- JAE .L_MouseAuto; { Mouse auto event }
-.L_NoButtonsDown:
- JMP .L_NoEventExit; { No event exit }
-.L_ButtonsDown:
- MOVB $0, %BH; { Preset no dbl click }
- CMPB DOWNBUTTONS, %BL; { Check to last down }
- JNE .L_MouseDown;
- CMPW DOWNWHEREX, %CX; { Check x position }
- JNE .L_MouseDown;
- CMPW DOWNWHEREY, %DX; { Check y position }
- JNE .L_MouseDown;
- MOVW %DI, %AX; { Transfer tick count }
- SUBW DOWNTICKS, %AX; { Sub last down count }
- CMPW DOUBLEDELAY, %AX; { Greater than delay? }
- JAE .L_MouseDown;
- MOVB $1, %BH; { Double click }
-.L_MouseDown:
- MOVB %BL, DOWNBUTTONS; { Hold down buttons }
- MOVW %CX, DOWNWHEREX; { Hold x down point }
- MOVW %DX, DOWNWHEREY; { Hold y down point }
- MOVW %DI, DOWNTICKS; { Hold tick value }
- MOVW %DI, AUTOTICKS; { Hold tick value }
- MOVW REPEATDELAY, %AX; { Load delay count }
- MOVW %AX, AUTODELAY; { Set delay time }
- MOVW $1, %AX; { Mouse down event }
- JMP .L_UpdateValues; { Update, svae & exit }
-.L_MouseUp:
- MOVW $2, %AX; { Mouse button up }
- JMP .L_UpdateValues; { Update, save & exit }
-.L_MouseMove:
- MOVW $4, %AX; { Mouse has moved }
- JMP .L_UpdateValues; { Update, save & exit }
-.L_MouseAuto:
- MOVW $8, %AX; { Mouse auto event }
- MOVW %DI, AUTOTICKS; { Reset auto ticks }
- MOVW $1, AUTODELAY; { Reset delay count }
-.L_UpdateValues:
- MOVB %BL, LASTBUTTONS; { Save last buttons }
- MOVB %BH, LASTDOUBLE; { Save double state }
- MOVW %CX, LASTWHEREX; { Save x position }
- MOVW %DX, LASTWHEREY; { Save y position }
- JMP .L_StoreAndExit; { Now store and exit }
-.L_NoEventExit:
- XORW %AX, %AX; { Clear register }
- MOVW %AX, %BX; { Clear register }
- MOVW %AX, %CX; { Clear register }
- MOVW %AX, %DX; { Clear register }
-.L_StoreAndExit:
- MOVL Event, %EDI; { Adress of event }
- CLD; { Set direction fwd }
- STOSW; { Save 1st word }
- XCHGW %BX, %AX; { Transfer register }
- STOSW; { Save 2nd word }
- XCHGW %CX, %AX; { Transfer register }
- STOSW; { Save 3rd word }
- XCHGW %DX, %AX; { Transfer register }
- STOSW; { Save 4th word }
-END;
-{$ENDIF}
-{$ENDIF}
-{$IFDEF OS_WINDOWS} { WIN/NT CODE }
-VAR Msg: TMsg;
-BEGIN
- Event.What := evNothing; { Preset no event }
- {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
- If PeekMessage(@Msg, 0, WM_MouseFirst,
- WM_MouseLast, pm_Remove) Then Begin { Fetch mouse message }
- {$ELSE} { OTHER COMPILERS }
- If PeekMessage(Msg, 0, WM_MouseFirst,
- WM_MouseLast, pm_Remove) Then Begin { Fetch mouse message }
- {$ENDIF}
- TranslateMessage(Msg); { Translate message }
- DispatchMessage(Msg); { Dispatch message }
- End;
-END;
-{$ENDIF}
-{$IFDEF OS_OS2} { OS2 CODE }
-VAR Msg: QMsg;
-BEGIN
- Event.What := evNothing; { Preset no event }
- If WinPeekMsg(Anchor, Msg, 0, WM_MouseFirst,
- WM_MouseLast, pm_Remove) Then Begin { Fetch mouse message }
- WinDispatchMsg(Anchor, Msg); { Dispatch message }
- End;
-END;
-{$ENDIF}
-{$endif not Use_API}
-
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ EVENT HANDLER CONTROL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -2463,7 +1172,6 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE InitEvents;
BEGIN
-{$ifdef Use_API}
If (ButtonCount <> 0) Then
begin { Mouse is available }
Mouse.InitMouse; { Hook the mouse }
@@ -2480,33 +1188,6 @@ BEGIN
LastWhereY:=MouseWhere.y;
MouseEvents := True; { Set initialized flag }
end;
-{$else not Use_API}
- If (ButtonCount <> 0) Then Begin { Mouse is available }
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
- EventQHead := @EventQueue; { Initialize head }
- EventQtail := @EventQueue; { Initialize tail }
- LastDouble := False; { Clear last double }
- LastButtons := 0; { Clear last buttons }
- DownButtons := 0; { Clear down buttons }
- HookMouse; { Hook the mouse }
- GetMousePosition(MouseWhere.X, MouseWhere.Y); { Get mouse position }
- LastWhereX := MouseWhere.X; { Set last x position }
- LastWhereY := MouseWhere.Y; { Set last y position }
- MouseEvents := True; { Set initialized flag }
- ShowMouseCursor; { Show the mouse }
- {$ENDIF}
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- MouseEvents := True; { Set initialized flag }
- {$ENDIF}
- {$IFDEF OS_OS2} { OS2 CODE }
- If (Anchor=0) Then Anchor := WinInitialize(0); { Create anchor block }
- If (MsgQue = 0) AND (Anchor <> 0) Then
- MsgQue := WinCreateMsgQueue(Anchor, 0); { Initialize queue }
- If (MsgQue = 0) Then Halt(254); { Check queue created }
- MouseEvents := True; { Set initialized flag }
- {$ENDIF}
- End;
-{$endif not Use_API}
END;
{---------------------------------------------------------------------------}
@@ -2514,60 +1195,11 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE DoneEvents;
BEGIN
-{$ifdef Use_API}
-{$else not Use_API}
- If MouseEvents Then Begin { Initialized check }
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
- HideMouseCursor; { Hide the mouse }
- MouseEvents := False; { Clear event flag }
- UnHookMouse; { Unhook the mouse }
- {$ENDIF}
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- MouseEvents := False; { Clr initialized flag }
- {$ENDIF}
- {$IFDEF OS_OS2} { OS2 CODE }
- If (MsgQue <> 0) Then WinDestroyMsgQueue(MsgQue);{ Destroy msg queue }
- If (Anchor <> 0) Then WinTerminate(Anchor); { Destroy anchor block }
- MsgQue := 0; { Zero msg queue handle }
- Anchor := 0; { Zero anchor block }
- MouseEvents := False; { Clr initialized flag }
- {$ENDIF}
- End;
-{$endif not Use_API}
END;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ VIDEO CONTROL ROUTINES }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
-{$ifndef Use_API}
-{$IFDEF OS_DOS} { DOS/DPMI CODE }
-{$IFDEF PPC_FPC} { FPC COMPILER ONLY }
-{ ******************************* REMARK ****************************** }
-{ This is purely temporary for FPC because the Graph is SuperVGA you }
-{ have no mouse pointer on screen because the mouse drivers don't go }
-{ up to supporting SVGA modes. This simply makes a cross hair so you }
-{ can see the mouse for now..will be fixed soon. }
-{ ****************************** END REMARK *** Leon de Boer, 04Nov99 * }
-VAR LastX, LastY: Integer;
-
-PROCEDURE ShowTheMouse; FAR;
-BEGIN
- If (MouseEvents = True) AND (HideCount = 0) { Mouse visible }
- Then Begin
- SetWriteMode(XORPut); { XOR write mode }
- SetColor(15); { Set color to white }
- Line(LastX-5, LastY, LastX+5, LastY); { Remove horz line }
- Line(LastX, LastY-5, LastX, LastY+5); { Remove vert line }
- LastX := MouseWhere.X; { Update x position }
- LastY := MouseWHere.Y; { Update y position }
- Line(LastX-5, LastY, LastX+5, LastY); { Draw horz line }
- Line(LastX, LastY-5, LastX, LastY+5); { Draw vert line }
- SetWriteMode(NormalPut); { Write mode to normal }
- End;
-END;
-{$ENDIF}
-{$ENDIF}
-{$endif not Use_API}
{---------------------------------------------------------------------------}
{ InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB }
@@ -2580,64 +1212,12 @@ VAR {$ifdef Use_API}I, J: Integer;
{$IFDEF OS_OS2} Ts, Fs: Integer; Ps: HPs; Tm: FontMetrics; {$ENDIF}
{$ENDIF}
BEGIN
- {$ifdef Use_API}
- Video.InitVideo;
- ScreenWidth:=Video.ScreenWidth;
- ScreenHeight:=Video.ScreenHeight;
- GetVideoMode(ScreenMode);
- I := ScreenWidth*8 -1; { Mouse width }
- J := ScreenHeight*8 -1; { Mouse height }
- SysScreenWidth := I + 1;
- SysScreenHeight := J + 1;
- SysFontWidth := 8; { Font width }
- SysFontHeight := 8; { Font height }
- {$else not Use_API}
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
- If (TextModeGFV = True) Then Begin { TEXT MODE GFV }
- I := ScreenWidth*8 -1; { Mouse width }
- J := ScreenHeight*8 -1; { Mouse height }
- SysScreenWidth := I + 1;
- SysScreenHeight := J + 1;
- End Else Begin { GRAPHICS MODE GFV }
- I := Detect; { Detect video card }
- J := 0; { Zero select mode }
- InitGraph(I, J, ''); { Initialize graphics }
- I := GetMaxX; { Fetch max x size }
- J := GetMaxY; { Fetch max y size }
- End;
- {$IFDEF PPC_FPC} { FPC DOS COMPILER }
- ASM
- MOVW $7, %AX; { Set function id }
- MOVW $0, %CX; { Clear register }
- MOVW I, %DX; { Maximum x size }
- INT $0x33; { Set mouse x movement }
- MOVW $8, %AX; { Set function id }
- MOVW $0, %CX; { Clear register }
- MOVW J, %DX; { Maximum y size }
- INT $0x33; { Set mouse y movement }
- END;
- Lock_Code(Pointer(@ShowTheMouse), 400); { Lock cursor code }
- If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV }
- MouseMoveProc := ShowTheMouse; { Set move function }
- ShowMouseProc := ShowTheMouse; { Set show function }
- HideMouseProc := ShowTheMouse; { Set hide function }
- End;
- {$ELSE} { OTHER DOS COMPILERS }
- ASM
- MOV AX, 7; { Set function id }
- XOR CX, CX; { Clear register }
- MOV DX, I; { Maximum x size }
- INT 33H; { Set mouse x movement }
- MOV AX, 8; { Set function id }
- XOR CX, CX; { Clear register }
- MOV DX, J; { Maximum y size }
- INT 33H; { Set mouse y movement }
- END;
- {$ENDIF}
- If (TextModeGFV = True) Then Begin { TEXT MODE GFV }
- SysFontWidth := 8; { Font width }
- SysFontHeight := 8; { Font height }
- End Else Begin { GRAPHICS MODE GFV }
+{$ifdef GRAPH_API}
+ I := Detect; { Detect video card }
+ J := 0; { Zero select mode }
+ InitGraph(I, J, ''); { Initialize graphics }
+ I := GetMaxX; { Fetch max x size }
+ J := GetMaxY; { Fetch max y size }
If (DefFontHeight = 0) Then { Font height not set }
J := (GetMaxY+1) DIV DefLineNum { Approx font height }
Else J := DefFontHeight; { Use set font height }
@@ -2651,110 +1231,19 @@ BEGIN
SysFontWidth; { Calc screen width }
ScreenHeight := (SysScreenHeight+1) DIV
SysFontHeight; { Calc screen height }
- End;
- {$ENDIF}
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- SysScreenWidth := GetSystemMetrics(
- SM_CXFullScreen)-GetSystemMetrics(SM_CXFrame); { Max screen width }
- SysScreenHeight := GetSystemMetrics(
- SM_CYFullScreen); { Max screen height }
- SystemParametersInfo(SPI_GETICONTITLELOGFONT,
- SizeOf(TLogFont), @TempFont, 0); { Get system font }
- With TempFont Do Begin
- If (DefFontHeight = 0) Then Begin { Font height not set }
- lfHeight := SysScreenHeight DIV DefLineNum; { Best guess height }
- End Else lfHeight := -DefFontHeight; { Specific font height }
- lfWidth := 0; { No specific width }
- lfEscapement := 0; { No specifics }
- lfOrientation := 0; { Normal orientation }
- lfWeight := DefFontWeight; { Default font weight }
- lfItalic := 0; { No italics }
- lfUnderline := 0; { No underlines }
- lfStrikeOut := 0; { No strikeouts }
- lfCharSet := ANSI_CharSet; { ANSI font set }
- lfOutPrecision := Out_Default_Precis; { Default precision out }
- lfClipPrecision := Clip_Default_Precis; { Default clip precision }
- lfQuality := Proof_Quality; { Proof quality }
- lfPitchAndFamily:= Variable_Pitch OR
- Fixed_Pitch; { Either fitch format }
-(* {$IFDEF WESTERNS}
- FillChar(lfFaceName, SizeOf(lfFaceName), #0); { Clear memory area }
- Move(DefFontStyle[1], lfFacename,
- Length(DefFontStyle)); { Transfer style name }
- {$ELSE}
- DefFontStyle[0] := Chr(StrLen(lfFacename));
- Move(lfFacename, DefFontStyle[1], Ord(DefFontStyle[0]));
- {$ENDIF}*)
- End;
- {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
- DefGFVFont := CreateFontIndirect(@TempFont); { Create a default font }
- {$ELSE}
- DefGFVFont := CreateFontIndirect(TempFont); { Create a default font }
- {$ENDIF}
- Dc := GetDc(0); { Get screen context }
- Mem := CreateCompatibleDC(Dc); { Compatable context }
- SelectObject(Mem, DefGFVFont); { Select the font }
- {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
- GetTextMetrics(Mem, @Tm); { Get text metrics }
- {$ELSE} { OTHER COMPILERS }
- GetTextMetrics(Mem, Tm); { Get text metrics }
- {$ENDIF}
- SysFontWidth := Tm.tmaveCharWidth+1; { Ave char font width }
- SysFontHeight := Tm.tmHeight; { Ave char font height }
- DeleteDc(Mem); { Destroy context }
- ReleaseDc(0, Dc); { Release context }
- {$ENDIF}
- {$IFDEF OS_OS2} { OS2 CODE }
- Ts := WinQuerySysValue(HWND_Desktop,
- SV_CYTitleBar) + 2*WinQuerySysValue(HWND_Desktop,
- SV_CYSizeBorder); { Title size }
- Fs := 2*WinQuerySysValue(HWND_DeskTop,
- SV_CXSizeBorder); { Frame size }
- SysScreenWidth := WinQuerySysValue(HWND_Desktop,
- SV_CXFullScreen) - Fs; { Max screen width }
- SysScreenHeight := WinQuerySysValue(HWND_Desktop,
- SV_CYFullScreen) - Ts; { Max screen height }
- (*With DefGFVFont Do Begin
- usRecordLength := SizeOf(fAttrs); { Structure size }
- fsSelection := $20; { Uses default selection }
- lMatch := 0; { Does not force match }
- idRegistry := 0; { Uses default registry }
- usCodePage := 850; { Code-page 850 }
- If (DefFontHeight = 0) Then Begin { Font height not set }
- lMaxBaselineExt := SysScreenHeight DIV DefLineNum; { Best guess height }
- End Else lMaxBaselineExt := DefFontHeight; { Specific font height }
- lAveCharWidth := 0; { Req font default width }
- fsType := 0; { Uses default type }
- fsFontUse := fAttr_FontUse_Nomix; { Doesn't mix with graphics }
- FillChar(szFaceName, SizeOf(szFaceName), #0); { Clear memory area }
- Move(DefFontStyle[1], szFacename,
- Length(DefFontStyle)); { Transfer style name }
- End;*)
- Ps := WinGetPS(HWND_Desktop); { Get desktop PS }
- (*GpiCreateLogFont(Ps, Nil, 1, DefGFVFont);*) { Create the font }
- GpiQueryFontMetrics(Ps, SizeOf(Tm), Tm); { Get text metrics }
- SysFontWidth := Tm.lAveCharWidth+1; { Transfer font width }
- SysFontHeight := Tm.lMaxBaselineExt; { Transfer font height }
- WinReleasePS(Ps); { Release desktop PS }
- DefPointer := WinQuerySysPointer(HWND_DESKTOP,
- SPTR_ARROW, False); { Hold default pointer }
- {$ENDIF}
- {$IFNDEF OS_DOS} { WIN/NT/OS2 ONLY }
- ScreenWidth := SysScreenWidth DIV SysFontWidth; { Calc screen width }
- ScreenHeight := SysScreenHeight DIV SysFontHeight;{ Calc screen height }
- SysScreenWidth := ScreenWidth * SysFontWidth; { Actual width }
- SysScreenHeight := ScreenHeight * SysFontHeight; { Actual height }
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- Inc(SysScreenWidth, 2*GetSystemMetrics(SM_CXFrame));{ Max screen width }
- Inc(SysScreenHeight, GetSystemMetrics(SM_CYCaption)
- + GetSystemMetrics(SM_CYFrame)); { Max screen height }
- {$ENDIF}
- {$IFDEF OS_OS2} { OS2 CODE }
- Inc(SysScreenWidth, Fs); { Max screen width }
- Inc(SysScreenHeight, Ts); { Max screen height }
- {$ENDIF}
- {$ENDIF}
- {$endif not Use_API}
+{$else not GRAPH_API}
+ Video.InitVideo;
+ ScreenWidth:=Video.ScreenWidth;
+ ScreenHeight:=Video.ScreenHeight;
+ SetViewPort(0,0,ScreenWidth,ScreenHeight,true,true);
+ GetVideoMode(ScreenMode);
+ I := ScreenWidth*8 -1; { Mouse width }
+ J := ScreenHeight*8 -1; { Mouse height }
+ SysScreenWidth := I + 1;
+ SysScreenHeight := J + 1;
+ SysFontWidth := 8; { Font width }
+ SysFontHeight := 8; { Font height }
+{$endif not GRAPH_API}
END;
{---------------------------------------------------------------------------}
@@ -2762,39 +1251,10 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE DoneVideo;
BEGIN
- {$ifdef Use_API}
- Video.DoneVideo;
+ {$ifdef GRAPH_API}
+ CloseGraph;
{$else not Use_API}
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
- {$IFDEF PPC_FPC}
- MouseMoveProc := Nil; { Clr mouse move ptr }
- ShowMouseProc := Nil; { Clr show mouse ptr }
- HideMouseProc := Nil; { Clr hide mouse ptr }
- UnLock_Code(Pointer(@ShowTheMouse), 400); { Unlock cursor code }
- {$ENDIF}
- If (TextModeGFV <> True) Then CloseGraph { Close down graphics }
- Else Begin { Text mode gfv }
- {$IFDEF PPC_FPC} { FPC DOS COMPILER }
- ASM
- MOVW SCREENMODE, %AX; { Original screen mode }
- PUSH %EBP; { Save register }
- INT $0x10; { Reset video }
- POP %EBP; { Restore register }
- END;
- {$ELSE} { OTHER DOS COMPILERS }
- ASM
- MOV AX, ScreenMode; { Original screen mode }
- PUSH BP; { Save register }
- INT 10H; { Reset video }
- POP BP; { Restore register }
- END;
- {$ENDIF}
- End;
- {$ENDIF}
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- If (DefGFVFont <> 0) Then { Check font created }
- DeleteObject(DefGFVFont); { Delete the font }
- {$ENDIF}
+ Video.DoneVideo;
{$endif not Use_API}
END;
@@ -2803,9 +1263,9 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE ClearScreen;
BEGIN
- {$ifdef Use_API}
+ {$ifndef GRAPH_API}
Video.ClearScreen;
- {$endif Use_API}
+ {$endif GRAPH_API}
END;
{---------------------------------------------------------------------------}
@@ -2855,29 +1315,8 @@ END;
{ PrintStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 18Feb99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE PrintStr (CONST S: String);
-{$IFDEF OS_WINDOWS} VAR Ts: String; {$ENDIF}
-{$IFDEF OS_OS2} VAR Ts: String; {$ENDIF}
BEGIN
- {$IFDEF OS_DOS} { DOS/DPMI CODE }
Write(S); { Write to screen }
- {$ENDIF}
- {$IFDEF OS_LINUX} { LINIX CODE }
- Write(S); { Write to screen }
- {$ENDIF}
- {$IFDEF OS_WINDOWS} { WIN/NT CODE }
- Ts := S + #0; { Make asciiz }
- {$IFNDEF PPC_SPEED} { NON SPEED COMPILER }
- MessageBox(0, @Ts[1], Nil, mb_Ok OR mb_IconStop);{ Display to screen }
- {$ELSE} { SYBIL 2+ COMPILER }
- MessageBox(0, CString(@Ts[1]), Nil, mb_Ok OR
- mb_IconStop); { Display to screen }
- {$ENDIF}
- {$ENDIF}
- {$IFDEF OS_OS2} { OS2 CODE }
- Ts := S + #0; { Make asciiz }
- WinMessageBox(0, 0, @Ts[1], Nil, mb_Ok OR
- 0, mb_IconHand); { Display to screen }
- {$ENDIF}
END;
{---------------------------------------------------------------------------}
@@ -2983,11 +1422,7 @@ BEGIN
ResultLength := 0; { Zero result length }
FormatIndex := 1; { Format index to 1 }
HandleParameter(0); { Handle parameter }
- {$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
SetLength(Result, ResultLength); { Set string length }
- {$ELSE} { OTHER COMPILERS }
- Result[0] := Chr(ResultLength); { Set string length }
- {$ENDIF}
END;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -3027,19 +1462,22 @@ END;
BEGIN
ButtonCount := DetectMouse; { Detect mouse }
DetectVideo; { Detect video }
- {$ifdef Use_API}
+ { text mode is the default mode }
TextModeGFV:=True;
InitKeyboard;
- {$endif Use_API}
{$ifdef Graph_API}
TextModeGFV:=false;
{$endif Graph_API}
+
SaveExit := ExitProc; { Save old exit }
ExitProc := @ExitDrivers; { Set new exit }
END.
{
$Log$
- Revision 1.9 2001-05-07 22:22:03 pierre
+ Revision 1.10 2001-05-10 16:46:27 pierre
+ + some improovements made
+
+ Revision 1.9 2001/05/07 22:22:03 pierre
* removed NO_WINDOW cond, added GRAPH_API
Revision 1.8 2001/05/04 15:43:45 pierre
@@ -3062,6 +1500,29 @@ END.
Revision 1.2 2000/08/24 12:00:21 marco
* CVS log and ID tags
-
-
}
+{******************[ REVISION HISTORY ]********************}
+{ Version Date Fix }
+{ ------- --------- --------------------------------- }
+{ 1.00 26 Jul 96 First DOS/DPMI platform release }
+{ 1.10 18 Nov 97 Windows conversion added. }
+{ 1.20 29 Aug 97 Platform.inc sort added. }
+{ 1.30 10 Jun 98 Virtual pascal 2.0 code added. }
+{ 1.40 13 Jul 98 Added FormatStr by Marco Schmidt. }
+{ 1.50 14 Jul 98 Fixed width = 0 in FormatStr. }
+{ 1.60 13 Aug 98 Complete rewrite of FormatStr. }
+{ 1.70 10 Sep 98 Added mouse int hook for FPC. }
+{ 1.80 10 Sep 98 Checks run & commenting added. }
+{ 1.90 15 Oct 98 Fixed for FPC version 0.998 }
+{ 1.91 18 Feb 99 Added PrintStr functions }
+{ 1.92 18 Feb 99 FormatStr literal '%' fix added }
+{ 1.93 10 Jul 99 Sybil 2.0 code added }
+{ 1.94 15 Jul 99 Fixed for FPC 0.9912 release }
+{ 1.95 26 Jul 99 Windows..Scales to GFV system font }
+{ 1.96 30 Jul 99 Fixed Ctrl+F1..F10 in GetKeyEvent }
+{ 1.97 07 Sep 99 InitEvent, DoneEvent fixed for OS2 }
+{ 1.98 09 Sep 99 GetMouseEvent fixed for OS2. }
+{ 1.99 03 Nov 99 FPC windows support added. }
+{ 2.00 26 Nov 99 Graphics stuff moved to GFVGraph }
+{ 2.01 21 May 00 DOS fixed to use std GRAPH unit }
+{**********************************************************}
diff --git a/fvision/gfvgraph.pas b/fvision/gfvgraph.pas
index 020441cfd8..956054acce 100644
--- a/fvision/gfvgraph.pas
+++ b/fvision/gfvgraph.pas
@@ -293,25 +293,28 @@ END;
PROCEDURE SetViewPort (X1, Y1, X2, Y2: Integer; Clip, TextMode: Boolean);
BEGIN
{$IFDEF GRAPH_API}
- If TextMode Then Begin { TEXT MODE GFV }
+ If TextMode Then Begin { TEXT MODE GFV }
{$ENDIF GRAPH_API}
If (X1 < 0) Then X1 := 0; { X1 negative fix }
- If (X1 > SysScreenWidth) Then
- X1 := SysScreenWidth; { X1 off screen fix }
+ If (X1 >SysScreenWidth) Then
+ X1 := SysScreenWidth; { X1 off screen fix }
If (Y1 < 0) Then Y1 := 0; { Y1 negative fix }
If (Y1 > SysScreenHeight) Then
- Y1 := SysScreenHeight; { Y1 off screen fix }
+ Y1 := SysScreenHeight; { Y1 off screen fix }
If (X2 < 0) Then X2 := 0; { X2 negative fix }
If (X2 > SysScreenWidth) Then
- X2 := SysScreenWidth; { X2 off screen fix }
+ X2 := SysScreenWidth; { X2 off screen fix }
If (Y2 < 0) Then Y2 := 0; { Y2 negative fix }
If (Y2 > SysScreenHeight) Then
- Y2 := SysScreenHeight; { Y2 off screen fix }
+ Y2 := SysScreenHeight; { Y2 off screen fix }
ViewPort.X1 := X1; { Set X1 port value }
ViewPort.Y1 := Y1; { Set Y1 port value }
ViewPort.X2 := X2; { Set X2 port value }
ViewPort.Y2 := Y2; { Set Y2 port value }
ViewPort.Clip := Clip; { Set port clip value }
+{$ifdef DEBUG}
+ Writeln(stderr,'New ViewPort(',X1,',',Y1,',',X2,',',Y2,')');
+{$endif DEBUG}
Cxp := X1; { Set current x pos }
Cyp := Y1; { Set current y pos }
{$IFDEF GRAPH_API}
@@ -333,7 +336,7 @@ BEGIN
{$IFDEF GRAPH_API}
If TextMode Then
{$ENDIF GRAPH_API}
- GetMaxX := SysScreenWidth-1 { Screen width }
+ GetMaxX := SysScreenWidth-1 { Screen width }
{$IFDEF GRAPH_API}
Else GetMaxX := Graph.GetMaxX; { Call graph func }
{$ENDIF GRAPH_API}
@@ -398,7 +401,10 @@ END;
END.
{
$Log$
- Revision 1.7 2001-05-07 23:36:35 pierre
+ Revision 1.8 2001-05-10 16:46:28 pierre
+ + some improovements made
+
+ Revision 1.7 2001/05/07 23:36:35 pierre
NO_WINDOW cond removed
Revision 1.6 2001/05/07 22:22:03 pierre
diff --git a/fvision/views.pas b/fvision/views.pas
index f6fda12453..8c4dc3f40e 100644
--- a/fvision/views.pas
+++ b/fvision/views.pas
@@ -57,17 +57,6 @@ UNIT Views;
{==== Compiler directives ===========================================}
-{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
- {$F+} { Force far calls - Used because of the FirstThat, ForNext ... }
- {$A+} { Word Align Data }
- {$B-} { Allow short circuit boolean evaluations }
- {$O+} { This unit may be overlaid }
- {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
- {$P-} { Normal string variables }
- {$N-} { No 80x87 code generation }
- {$E+} { Emulation is on }
-{$ENDIF}
-
{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
{$S-} { Disable Stack Checking }
@@ -164,6 +153,7 @@ CONST
goTabSelect = $0008; { Tab selectable }
goEveryKey = $0020; { Report every key }
goEndModal = $0040; { End modal }
+ goNoShadow = $0080; { Do not write shadows }
goGraphView = $1000; { Raw graphic view }
goGraphical = $2000; { Graphical view }
@@ -297,15 +287,6 @@ CONST
wnNoNumber = 0; { Window has no num }
MaxViewWidth = 132; { Max view width }
-{$IFDEF OS_WINDOWS} { WIN/NT CODE }
-
-{---------------------------------------------------------------------------}
-{ WIN32/NT LABEL CONSTANTS FOR WINDOW PROPERTY CALLS }
-{---------------------------------------------------------------------------}
-CONST
- ViewPtr = 'TVWINPTR'+#0; { View ptr label }
-
-{$ENDIF}
{***************************************************************************}
{ PUBLIC TYPE DEFINITIONS }
@@ -420,6 +401,7 @@ TYPE
PROCEDURE DrawFocus; Virtual;
PROCEDURE DrawCursor; Virtual;
PROCEDURE DrawBorder; Virtual;
+ PROCEDURE DrawShadow; Virtual;
PROCEDURE HideCursor;
PROCEDURE ShowCursor;
PROCEDURE BlockCursor;
@@ -480,7 +462,8 @@ TYPE
Count: Integer);
PROCEDURE DragView (Event: TEvent; Mode: Byte; Var Limits: TRect;
MinSize, MaxSize: TPoint);
-
+ PROCEDURE WriteAbs(X, Y, L :Integer;var Buf);
+ PROCEDURE WriteShadow(X1, Y1, X2, Y2 : Integer);
FUNCTION FontWidth: Integer;
FUNCTION Fontheight: Integer;
@@ -725,37 +708,6 @@ FUNCTION CreateIdScrollBar (X, Y, Size, Id: Integer; Horz: Boolean): PScrollBar;
{ INITIALIZED PUBLIC VARIABLES }
{***************************************************************************}
-{$IFDEF OS_WINDOWS} { WIN/NT CODE }
-
-TYPE TColorRef = LongInt; { TColorRef defined }
-
-{---------------------------------------------------------------------------}
-{ INITIALIZED WIN/NT VARIABLES }
-{---------------------------------------------------------------------------}
-CONST
- ColRef: Array [0..15] Of TColorRef = { Standard colour refs }
- (rgb_Black, rgb_Blue, rgb_Green, rgb_Cyan,
- rgb_Red, rgb_Magenta, rgb_Brown, rgb_LightGray,
- rgb_DarkGray, rgb_LightBlue, rgb_LightGreen,
- rgb_LightCyan, rgb_LightRed, rgb_LightMagenta,
- rgb_Yellow, rgb_White);
- ColBrush: Array [0..15] Of HBrush =
- (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
- ColPen: Array [0..15] Of HPen =
- (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
-{$ENDIF}
-
-{$IFDEF OS_OS2} { OS2 CODE }
-{---------------------------------------------------------------------------}
-{ INITIALIZED OS2 VARIABLES }
-{---------------------------------------------------------------------------}
-CONST
- ColRef: Array [0..15] Of LongInt =
- (clr_Black, clr_DarkBlue, clr_DarkGreen, clr_DarkCyan,
- clr_DarkRed, clr_DarkPink, clr_Brown, clr_PaleGray,
- clr_DarkGray, clr_Blue, clr_Green, clr_Cyan,
- clr_Red, clr_Pink, clr_Yellow, clr_White);
-{$ENDIF}
{---------------------------------------------------------------------------}
{ INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES }
@@ -1201,10 +1153,17 @@ END;
FUNCTION TView.OverlapsArea (X1, Y1, X2, Y2: Integer): Boolean;
BEGIN
OverLapsArea := False; { Preset false }
- If (RawOrigin.X > X2) Then Exit; { Area to the left }
- If ((RawOrigin.X + RawSize.X) < X1) Then Exit; { Area to the right }
- If (RawOrigin.Y > Y2) Then Exit; { Area is above }
- If ((RawOrigin.Y + RawSize.Y) < Y1) Then Exit; { Area is below }
+ If TextModeGFV then Begin
+ If (Origin.X > X2) Then Exit; { Area to the left }
+ If ((Origin.X + Size.X) < X1) Then Exit; { Area to the right }
+ If (Origin.Y > Y2) Then Exit; { Area is above }
+ If ((Origin.Y + Size.Y) < Y1) Then Exit; { Area is below }
+ End Else Begin
+ If (RawOrigin.X > X2) Then Exit; { Area to the left }
+ If ((RawOrigin.X + RawSize.X) < X1) Then Exit; { Area to the right }
+ If (RawOrigin.Y > Y2) Then Exit; { Area is above }
+ If ((RawOrigin.Y + RawSize.Y) < Y1) Then Exit; { Area is below }
+ End;
OverLapsArea := True; { Return true }
END;
@@ -1267,7 +1226,14 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE TView.DrawView;
VAR ViewPort: ViewPortType; { Common variables }
+ Parent : PGroup;
BEGIN
+ Parent:=Owner;
+ While Assigned(Parent) do Begin
+ If (Parent^.LockFlag>0) then
+ exit;
+ Parent:=Parent^.Owner;
+ End;
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfExposed <> 0) AND { View is exposed }
(State AND sfIconised = 0) Then Begin { View not iconised }
@@ -1277,6 +1243,7 @@ BEGIN
ViewPort.X2, ViewPort.Y2) Then Begin { Must be in area }
HideMouseCursor; { Hide mouse cursor }
If (DrawMask = 0) OR (DrawMask = vdNoChild) { No special masks set }
+ { OR Assigned(LimitsLocked) }
Then Begin { Treat as a full redraw }
DrawBackGround; { Draw background }
Draw; { Draw interior }
@@ -1287,18 +1254,36 @@ BEGIN
If (Options AND ofFramed <> 0) OR
(GOptions AND goThickFramed <> 0) { View has border }
Then DrawBorder; { Draw border }
+ If ((State AND sfShadow) <> 0) AND
+ (GOptions And goNoShadow = 0) Then
+ DrawShadow;
End Else Begin { Masked draws only }
If (DrawMask AND vdBackGnd <> 0) Then { Chk background mask }
- DrawBackGround; { Draw background }
+ Begin
+ DrawMask := DrawMask and Not vdBackGnd;
+ DrawBackGround; { Draw background }
+ end;
If (DrawMask AND vdInner <> 0) Then { Check Inner mask }
- Draw; { Draw interior }
+ Begin
+ DrawMask := DrawMask and Not vdInner;
+ Draw; { Draw interior }
+ End;
If (DrawMask AND vdFocus <> 0)
- AND (GOptions AND goDrawFocus <> 0)
- Then DrawFocus; { Check focus mask }
+ AND (GOptions AND goDrawFocus <> 0) then
+ Begin
+ DrawMask := DrawMask and Not vdFocus;
+ DrawFocus; { Check focus mask }
+ End;
If (DrawMask AND vdCursor <> 0) Then { Check cursor mask }
- DrawCursor; { Draw any cursor }
+ Begin
+ DrawMask := DrawMask and Not vdCursor;
+ DrawCursor; { Draw any cursor }
+ End;
If (DrawMask AND vdBorder <> 0) Then { Check border mask }
- DrawBorder; { Draw border }
+ Begin
+ DrawMask := DrawMask and Not vdBorder;
+ DrawBorder; { Draw border }
+ End;
End;
ShowMouseCursor; { Show mouse cursor }
End;
@@ -1342,6 +1327,8 @@ VAR I : sw_integer;
VerticalBar,
LeftLowCorner,
RightLowCorner : Char;
+ Color : Byte;
+ Focused : Boolean;
BEGIN
If (TextModeGFV = FALSE) Then Begin { GRAPHICS GFV MODE }
BiColorRectangle(0, 0, RawSize.X, RawSize.Y,
@@ -1355,7 +1342,10 @@ BEGIN
White, DarkGray, True); { Draw highlights }
End;
End Else Begin { TEXT GFV MODE }
- If not Focus or (GOptions AND goThickFramed = 0) then
+ Focused:=(State AND (sfSelected + sfModal)<>0);
+ if Assigned(Owner) then
+ Focused := Focused AND (@Self = Owner^.First);
+ If not Focused or (GOptions AND goThickFramed = 0) then
begin
LeftUpCorner:='�';
RightUpCorner:='�';
@@ -1373,20 +1363,49 @@ BEGIN
LeftLowCorner:='�';
RightLowCorner:='�';
end;
- WriteChar(0,0,LeftUpCorner,1,1);
- WriteChar(1,0,HorizontalBar,1,Size.X-2);
- WriteChar(Size.X-1,0,RightUpcorner,1,1);
+ if Focused then
+ Color := 2
+ else
+ Color := 1;
+ WriteChar(0,0,LeftUpCorner,Color,1);
+ WriteChar(1,0,HorizontalBar,Color,Size.X-2);
+ WriteChar(Size.X-1,0,RightUpcorner,Color,1);
For i:=1 to Size.Y -1 do
begin
- WriteChar(0,i,VerticalBar,1,1);
- WriteChar(Size.X-1,i,VerticalBar,1,1);
+ WriteChar(0,i,VerticalBar,Color,1);
+ WriteChar(Size.X-1,i,VerticalBar,Color,1);
end;
- WriteChar(0,Size.Y-1,LeftLowCorner,1,1);
- WriteChar(1,Size.Y-1,HorizontalBar,1,Size.X-2);
- WriteChar(Size.X-1,Size.Y-1,RightLowCorner,1,1);
+ WriteChar(0,Size.Y-1,LeftLowCorner,Color,1);
+ WriteChar(1,Size.Y-1,HorizontalBar,Color,Size.X-2);
+ WriteChar(Size.X-1,Size.Y-1,RightLowCorner,Color,1);
End;
END;
+PROCEDURE TView.DrawShadow;
+VAR X1, Y1, X2, Y2 : Integer;
+BEGIN
+ If not TextModeGFV then
+ exit;
+ If Assigned(Owner) Then Begin
+ X1:=RawOrigin.X+RawSize.X+1;
+ X2:=X1+ShadowSize.X*SysFontWidth;
+ Y1:=RawOrigin.Y+SysFontHeight;
+ Y2:=RawOrigin.Y+RawSize.Y+1+ShadowSize.Y*SysFontHeight;
+ GOptions := GOptions OR goNoShadow;
+ Owner^.RedrawArea(X1,Y1,X2,Y2);
+ WriteShadow(X1 div SysFontWidth, Y1 div SysFontHeight,
+ X2 div SysFontWidth, Y2 div SysFontHeight);
+ X1:=RawOrigin.X+SysFontWidth;
+ X2:=RawOrigin.X+RawSize.X+1;
+ Y1:=RawOrigin.Y+RawSize.Y+1;
+ Y2:=RawOrigin.Y+RawSize.Y+1+ShadowSize.Y*SysFontHeight;
+ Owner^.RedrawArea(X1,Y1,X2,Y2);
+ WriteShadow(X1 div SysFontWidth, Y1 div SysFontHeight,
+ X2 div SysFontWidth, Y2 div SysFontHeight);
+ GOptions := GOptions AND not goNoShadow;
+ End;
+END;
+
{--TView--------------------------------------------------------------------}
{ HideCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
{---------------------------------------------------------------------------}
@@ -1462,6 +1481,13 @@ BEGIN
Then Y2 := P^.RawOrigin.Y + P^.RawSize.Y; { Y maximum contain }
P := P^.Owner; { Move to owners owner }
End;
+ If TextModeGFV then Begin
+ X1 := X1 div SysFontWidth;
+ X2 := (X2 +SysFontWidth - 1) div SysFontWidth;
+ Y1 := Y1 div SysFontHeight;
+ Y2 := (Y2 +SysFontHeight -1) div SysFontHeight;
+ End;
+
If (LimitsLocked <> Nil) Then Begin { Locked = area redraw }
If (X2 < ViewPort.X1) Then Exit; { View left of locked }
If (X1 > ViewPort.X2) Then Exit; { View right of locked }
@@ -1482,38 +1508,48 @@ END;
PROCEDURE TView.DrawBackGround;
VAR Bc: Byte; X1, Y1, X2, Y2: Integer; ViewPort: ViewPortType;
X, Y: Integer;
+ Buf : TDrawBuffer;
BEGIN
If (GOptions AND goNoDrawView = 0) Then Begin { Non draw views exit }
If (State AND sfDisabled = 0) Then
Bc := GetColor(1) AND $F0 SHR 4 Else { Select back colour }
Bc := GetColor(4) AND $F0 SHR 4; { Disabled back colour }
GetViewSettings(ViewPort, TextModeGFV); { Get view settings }
- If (ViewPort.X1 <= RawOrigin.X) Then X1 := 0 { Right to left edge }
- Else X1 := ViewPort.X1-RawOrigin.X; { Offset from left }
- If (ViewPort.Y1 <= RawOrigin.Y) Then Y1 := 0 { Right to top edge }
- Else Y1 := ViewPort.Y1-RawOrigin.Y; { Offset from top }
- If (ViewPort.X2 >= RawOrigin.X+RawSize.X) Then
- X2 := RawSize.X Else { Right to right edge }
- X2 := ViewPort.X2-RawOrigin.X; { Offset from right }
- If (ViewPort.Y2 >= RawOrigin.Y+RawSize.Y) Then
- Y2 := RawSize.Y Else { Right to bottom edge }
- Y2 := ViewPort.Y2-RawOrigin.Y; { Offset from bottom }
- If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV }
- SetFillStyle(SolidFill, Bc); { Set fill colour }
- Bar(0, 0, X2-X1, Y2-Y1); { Clear the area }
- End Else Begin { TEXT MODE GFV }
- X1 := (RawOrigin.X+X1) DIV SysFontWidth;
- Y1 := (RawOrigin.Y+Y1) DIV SysFontHeight;
- X2 := (RawOrigin.X+X2) DIV SysFontWidth;
- Y2 := (RawOrigin.Y+Y2) DIV SysFontHeight;
+ If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV }
+ If (ViewPort.X1 <= RawOrigin.X) Then X1 := 0 { Right to left edge }
+ Else X1 := ViewPort.X1-RawOrigin.X; { Offset from left }
+ If (ViewPort.Y1 <= RawOrigin.Y) Then Y1 := 0 { Right to top edge }
+ Else Y1 := ViewPort.Y1-RawOrigin.Y; { Offset from top }
+ If (ViewPort.X2 >= RawOrigin.X+RawSize.X) Then
+ X2 := RawSize.X Else { Right to right edge }
+ X2 := ViewPort.X2-RawOrigin.X; { Offset from right }
+ If (ViewPort.Y2 >= RawOrigin.Y+RawSize.Y) Then
+ Y2 := RawSize.Y Else { Right to bottom edge }
+ Y2 := ViewPort.Y2-RawOrigin.Y; { Offset from bottom }
+ SetFillStyle(SolidFill, Bc); { Set fill colour }
+ Bar(0, 0, X2-X1, Y2-Y1); { Clear the area }
+ End Else Begin { TEXT MODE GFV }
+ If (ViewPort.X1 <= Origin.X) Then
+ X1 := Origin.X { Right to left edge }
+ Else X1 := ViewPort.X1; { Offset from left }
+ If (ViewPort.Y1 <= Origin.Y) Then
+ Y1 := Origin.Y { Right to top edge }
+ Else Y1 := ViewPort.Y1; { Offset from top }
+ If (ViewPort.X2 >= Origin.X+Size.X) Then
+ X2 := Origin.X + Size.X Else { Right to right edge }
+ X2 := ViewPort.X2; { Offset from right }
+ If (ViewPort.Y2 >= Origin.Y+Size.Y) Then
+ Y2 := Origin.Y + Size.Y Else { Right to bottom edge }
+ Y2 := ViewPort.Y2; { Offset from bottom }
If (State AND sfDisabled = 0) Then
Bc := GetColor(1) Else { Select back colour }
Bc := GetColor(4); { Disabled back colour }
- For Y := Y1 To Y2 Do
- For X := X1 To X2 Do Begin
- { FIXME: we shouldn't write direct here }
- VideoBuf^[(Y*Drivers.ScreenWidth+X)] := (Bc shl 8) or $20;
- End;
+ For X := X1 To X2 Do Begin
+ Buf[X-X1]:=(Bc shl 8) or $20;
+ End;
+ For Y := Y1 To Y2 Do Begin
+ WriteAbs(X1,Y, X2-X1, Buf);
+ End;
{ FIXME: we shouldn't update always here }
UpdateScreen(false);
End;
@@ -1560,6 +1596,8 @@ END;
{ SetDrawMask -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.SetDrawMask (Mask: Byte);
+VAR
+ OldMask : byte;
BEGIN
If (Options AND ofFramed = 0) AND { Check for no frame }
(GOptions AND goThickFramed = 0) AND { Check no thick frame }
@@ -1569,7 +1607,20 @@ BEGIN
Mask := Mask AND NOT vdCursor; { Clear cursor draw }
If (GOptions AND goDrawFocus = 0) Then { Check no focus draw }
Mask := Mask AND NOT vdFocus; { Clear focus draws }
+ OldMask:=DrawMask;
DrawMask := DrawMask OR Mask; { Set draw masks }
+ (*If TextModeGFV and (DrawMask<>0) and (DrawMask<>OldMask) then Begin
+ Mask:=vdBackGnd OR vdInner OR vdBorder OR vdCursor OR vdFocus;
+ If (Options AND ofFramed = 0) AND { Check for no frame }
+ (GOptions AND goThickFramed = 0) AND { Check no thick frame }
+ (GOptions AND goTitled = 0) Then { Check for title }
+ Mask := Mask AND NOT vdBorder; { Clear border draw }
+ If (State AND sfCursorVis = 0) Then { Check for no cursor }
+ Mask := Mask AND NOT vdCursor; { Clear cursor draw }
+ If (GOptions AND goDrawFocus = 0) Then { Check no focus draw }
+ Mask := Mask AND NOT vdFocus; { Clear focus draws }
+ DrawMask := DrawMask OR Mask; { Set draw masks }
+ End; *)
END;
{--TView--------------------------------------------------------------------}
@@ -1620,12 +1671,14 @@ BEGIN
If (Owner <> Nil) Then Owner^.ReDrawArea(
RawOrigin.X, RawOrigin.Y, RawOrigin.X +
RawSize.X, RawOrigin.Y + RawSize.Y); { Redraw old area }
+ Owner^.Lock;
Owner^.RemoveView(@Self); { Remove from list }
Owner^.InsertView(@Self, Target); { Insert into list }
State := State OR sfVisible; { Allow drawing again }
If (LastView <> Target) Then DrawView; { Draw the view now }
If (Options AND ofSelectable <> 0) Then { View is selectable }
If (Owner <> Nil) Then Owner^.ResetCurrent; { Reset current }
+ Owner^.Unlock;
End;
END;
@@ -1662,6 +1715,12 @@ PROCEDURE TView.ReDrawArea (X1, Y1, X2, Y2: Integer);
VAR HLimit: PView; ViewPort: ViewPortType;
BEGIN
GetViewSettings(ViewPort, TextModeGFV); { Hold view port }
+ If TextModeGFV then Begin
+ X1 := X1 div SysFontWidth;
+ X2 := (X2 +SysFontWidth - 1) div SysFontWidth;
+ Y1 := Y1 div SysFontHeight;
+ Y2 := (Y2 +SysFontHeight -1) div SysFontHeight;
+ End;
SetViewPort(X1, Y1, X2, Y2, ClipOn, TextModeGFV); { Set new clip limits }
HLimit := LimitsLocked; { Hold lock limits }
LimitsLocked := @Self; { We are the lock view }
@@ -1695,10 +1754,13 @@ END;
{ SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.SetState (AState: Word; Enable: Boolean);
-VAR Command: Word;
+VAR OldState, Command: Word;
+ ShouldDraw : Boolean;
BEGIN
+ OldState := State;
If Enable Then State := State OR AState { Set state mask }
Else State := State AND NOT AState; { Clear state mask }
+ ShouldDraw:=false;
If (AState AND sfVisible <> 0) Then Begin { Visibilty change }
If (Owner <> Nil) AND { valid owner }
(Owner^.State AND sfExposed <> 0) { If owner exposed }
@@ -1715,17 +1777,22 @@ BEGIN
If Enable Then Command := cmReceivedFocus { View gaining focus }
Else Command := cmReleasedFocus; { View losing focus }
Message(Owner, evBroadcast, Command, @Self); { Send out message }
+ SetDrawMask(vdBorder); { Set border draw mask }
+ ShouldDraw:=true;
End;
- If (GOptions AND goDrawFocus <> 0) Then Begin { Draw focus view }
+ If (GOptions AND goDrawFocus <> 0) AND
+ (((AState XOR OldState) AND sfFocused) <> 0) Then Begin { Draw focus view }
SetDrawMask(vdFocus); { Set focus draw mask }
- DrawView; { Redraw focus change }
+ ShouldDraw:=true;
End;
End;
If (AState AND (sfCursorVis + sfCursorIns) <> 0) { Change cursor state }
Then Begin
SetDrawMask(vdCursor); { Set cursor draw mask }
- DrawView; { Redraw the cursor }
+ ShouldDraw:=true;
End;
+ If ShouldDraw then
+ DrawView; { Redraw the border }
END;
{--TView--------------------------------------------------------------------}
@@ -2270,7 +2337,7 @@ FUNCTION TGroup.FirstThat (P: Pointer): PView; ASSEMBLER;
JNZ .L_LoopPoint; { Continue to last }
XOR %EAX, %EAX; { No views gave true }
.L_Exit:
- MOVL %EAX, __RESULT; { Return result }
+ {MOVL %EAX, __RESULT;not needed for assembler functions Return result }
END;
{--TGroup-------------------------------------------------------------------}
@@ -2529,7 +2596,7 @@ BEGIN
If (Current <> Nil) Then
Current^.SetState(sfFocused, Enable); { Focus current view }
If TextModeGFV then
- SetDrawMask(vdBackGnd OR vdFocus OR vdInner); { Set redraw masks }
+ SetDrawMask(vdBackGnd OR vdFocus OR vdInner OR vdBorder); { Set redraw masks }
End;
sfExposed: Begin
ForEach(@DoExpose); { Expose each subview }
@@ -4135,6 +4202,7 @@ END;
PROCEDURE TView.ClearArea (X1, Y1, X2, Y2: Integer; Colour: Byte);
VAR
X, Y: Integer; ViewPort: ViewPortType;
+ Buf : TDrawBuffer;
BEGIN
GetViewSettings(ViewPort, TextModeGFV); { Get viewport }
If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL GFV MODE }
@@ -4147,11 +4215,12 @@ BEGIN
Y1 := (RawOrigin.Y+Y1) DIV SysFontHeight;
X2 := (RawOrigin.X+X2-1) DIV SysFontWidth;
Y2 := (RawOrigin.Y+Y2-1) DIV SysFontHeight;
+ For X := X1 To X2 Do Begin
+ Buf[X-X1]:=(Colour shl 12) or $20;
+ End;
For Y := Y1 To Y2 Do
- For X := X1 To X2 Do Begin
- VideoBuf^[(Y*Drivers.ScreenWidth+X)] := (Colour shl 12) or $20;
- End;
- UpdateScreen(false);
+ WriteAbs(X1,Y, X2-X1, Buf);
+ UpdateScreen(false);
End;
END;
@@ -4197,7 +4266,7 @@ BEGIN
Dc := ODc; { Reset held context }
End;
{$ENDIF}
- {$ENDIF not NOT_IMPLEMENTED}
+ {$ENDIF NOT_IMPLEMENTED}
END;
PROCEDURE TView.FilletArc (Xc, Yc: Integer; Sa, Ea: Real; XRad, YRad, Ht: Integer;
@@ -4205,7 +4274,7 @@ Colour: Byte);
CONST RadConv = 57.2957795130823229; { Degrees per radian }
{$IFDEF OS_WINDOWS} VAR X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer; ODc: hDc; {$ENDIF}
BEGIN
- {$IFNDEF NOT_IMPLEMENTED}
+ {$IFDEF NOT_IMPLEMENTED}
{$IFDEF OS_WINDOWS}
If (HWindow <> 0) Then Begin { Valid window }
Xc := Xc - FrameSize;
@@ -4250,7 +4319,7 @@ BEGIN
Dc := ODc; { Reset held context }
End;
{$ENDIF}
- {$ENDIF not NOT_IMPLEMENTED}
+ {$ENDIF NOT_IMPLEMENTED}
END;
{--TView--------------------------------------------------------------------}
@@ -4300,28 +4369,26 @@ BEGIN
Y := Y - ViewPort.Y1; { Calc y position }
End;
For J := 1 To H Do Begin { For each line }
- K := X; { Reset x position }
- For I := 0 To (W-1) Do Begin { For each character }
- Cw := TextWidth(Chr(Lo(P^[L]))); { Width of this char }
- If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL MODE GFV }
+ If (TextModeGFV) Then Begin { TEXT MODE GFV }
+ WriteAbs(X,Y,W,P^[L]);
+ Inc(Y);
+ Inc(L,W);
+ End Else Begin
+ K := X; { Reset x position }
+ For I := 0 To (W-1) Do Begin { For each character }
+ Cw := TextWidth(Chr(Lo(P^[L]))); { Width of this char }
SetFillStyle(SolidFill, Hi(P^[L]) AND
- $F0 SHR 4); { Set back colour }
- SetColor(Hi(P^[L]) AND $0F); { Set text colour }
- Bar(K, Y, K+Cw, Y+FontHeight-1); { Clear text backing }
- OutTextXY(K, Y+2, Chr(Lo(P^[L]))); { Write text char }
+ $F0 SHR 4); { Set back colour }
+ SetColor(Hi(P^[L]) AND $0F); { Set text colour }
+ Bar(K, Y, K+Cw, Y+FontHeight-1); { Clear text backing }
+ OutTextXY(K, Y+2, Chr(Lo(P^[L]))); { Write text char }
Inc(K,Cw);
- End else Begin
- VideoBuf^[((y * Drivers.ScreenWidth)+k)] := P^[L];
- Inc(K);
+ Inc(L); { Next character }
End;
- Inc(L); { Next character }
- End;
- If Not TextModeGFV then
- Y := Y + SysFontHeight { Next line down }
- Else
- Inc(Y); { Next line down }
- end;
+ Y := Y + SysFontHeight; { Next line down }
+ end;
Video.UpdateScreen(false);
+ End;
end;
END;
@@ -4351,25 +4418,22 @@ BEGIN
Y := Y - ViewPort.Y1; { Calc y position }
End;
For J := 1 To H Do Begin { For each line }
- K := X; { Reset x position }
- For I := 0 To (W-1) Do Begin { For each character }
- Cw := TextWidth(Chr(Lo(P^[I]))); { Width of this char }
- If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL MODE GFV }
- SetFillStyle(SolidFill, Hi(P^[I]) AND
- $F0 SHR 4); { Set back colour }
- SetColor(Hi(P^[I]) AND $0F); { Set text colour }
- Bar(K, Y, K+Cw, Y+FontHeight-1); { Clear text backing }
- OutTextXY(K, Y+2, Chr(Lo(P^[I]))); { Write text char }
- Inc(K,Cw);
- End Else Begin { TEXT MODE GFV }
- VideoBuf^[((y * Drivers.ScreenWidth)+k)] := P^[I];
- Inc(K);
- End;
+ If (TextModeGFV) Then Begin { TEXT MODE GFV }
+ WriteAbs(X,Y,W,P^);
+ Inc(Y);
+ End Else Begin
+ K := X; { Reset x position }
+ For I := 0 To (W-1) Do Begin { For each character }
+ Cw := TextWidth(Chr(Lo(P^[I]))); { Width of this char }
+ SetFillStyle(SolidFill, Hi(P^[I]) AND
+ $F0 SHR 4); { Set back colour }
+ SetColor(Hi(P^[I]) AND $0F); { Set text colour }
+ Bar(K, Y, K+Cw, Y+FontHeight-1); { Clear text backing }
+ OutTextXY(K, Y+2, Chr(Lo(P^[I]))); { Write text char }
+ Inc(K,Cw);
+ End;
+ Y := Y + SysFontHeight; { Next line down }
End;
- If Not TextModeGFV then
- Y := Y + SysFontHeight { Next line down }
- Else
- Inc(Y); { Next line down }
end;
Video.UpdateScreen(false);
End;
@@ -4406,6 +4470,7 @@ END;
PROCEDURE TView.WriteStr (X, Y: Integer; Str: String; Color: Byte);
VAR Fc, Bc, B: Byte; X1, Y1, X2, Y2: Integer;
Tix, Tiy, Ti: Integer; ViewPort: ViewPortType;
+ Buf : TDrawBuffer;
BEGIN
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfExposed <> 0) AND { View is exposed }
@@ -4441,9 +4506,9 @@ BEGIN
Tix := X DIV SysFontWidth;
Tiy := Y DIV SysFontHeight;
For Ti := 1 To length(Str) Do Begin
- VideoBuf^[((Tiy * Drivers.ScreenWidth)+Tix)] := (GetColor(Color) shl 8) or Ord(Str[Ti]);
- Inc(Tix);
+ Buf[Ti-1]:=(GetColor(Color) shl 8) or Ord(Str[Ti]);
end;
+ WriteAbs(Tix,TiY,Length(Str),Buf);
End;
UpdateScreen(false);
End;
@@ -4452,6 +4517,7 @@ END;
PROCEDURE TView.WriteChar (X, Y: Integer; C: Char; Color: Byte;
Count: Integer);
VAR Fc, Bc: Byte; I, Ti, Tix, Tiy: Integer; Col: Word; S: String; ViewPort: ViewPortType;
+ Buf : TDrawBuffer;
BEGIN
If (State AND sfVisible <> 0) AND { View visible }
(State AND sfExposed <> 0) Then Begin { View exposed }
@@ -4459,26 +4525,31 @@ BEGIN
Col := GetColor(Color); { Get view color }
Fc := Col AND $0F; { Foreground colour }
Bc := Col AND $F0 SHR 4; { Background colour }
- X := RawOrigin.X + X*FontWidth; { X position }
- Y := RawOrigin.Y + Y*FontHeight; { Y position }
+ If (X >= 0) AND (Y >= 0) AND ((GOptions and goGraphView)=0) Then Begin
+ X := RawOrigin.X+X*FontWidth; { X position }
+ Y := RawOrigin.Y+Y*FontHeight; { Y position }
+ End Else Begin
+ X := RawOrigin.X + Abs(X);
+ Y := RawOrigin.Y + Abs(Y);
+ End;
FillChar(S[1], 255, C); { Fill the string }
While (Count>0) Do Begin
- If (Count>255) Then I := 255 Else I := Count; { Size to make }
+ If (Count>Size.X) Then I := Size.X Else I := Count; { Size to make }
S[0] := Chr(I); { Set string length }
If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL MODE GFV }
SetFillStyle(SolidFill, Bc); { Set fill style }
Bar(X-ViewPort.X1, Y-ViewPort.Y1,
- X-ViewPort.X1+Length(S)*FontWidth,
+ X-ViewPort.X1+I*FontWidth,
Y-ViewPort.Y1+FontHeight-1);
SetColor(Fc);
OutTextXY(X-ViewPort.X1, Y-ViewPort.Y1, S); { Write text char }
End Else Begin { TEXT MODE GFV }
Tix := X DIV SysFontWidth;
Tiy := Y DIV SysFontHeight;
- For Ti := 1 To length(S) Do Begin
- VideoBuf^[((Tiy * Drivers.ScreenWidth)+Tix)] := (GetColor(Color) shl 8) or Ord(S[Ti]);
- Inc(Tix);
+ For Ti := 1 To I Do Begin
+ Buf[Ti-1]:=(GetColor(Color) shl 8) or Ord(S[Ti]);
End;
+ WriteAbs(TiX,TiY,Length(S),Buf);
End;
Count := Count - I; { Subtract count }
If TextModeGFV then
@@ -4491,6 +4562,138 @@ BEGIN
End;
END;
+{define DirectWrite}
+PROCEDURE TView.WriteAbs(X, Y, L : Integer; Var Buf);
+VAR
+ P: PGroup;
+ PrevP,PP : PView;
+ CurOrigin : TPoint;
+ I,XI : longint;
+ ViewPort : ViewPortType;
+BEGIN
+ { Direct wrong method }
+ GetViewSettings(ViewPort, TextModeGFV); { Get set viewport }
+{$ifdef DirectWrite}
+ For i:=0 to L-1 do Begin
+ if (X+I>=ViewPort.X1) AND (Y>=ViewPort.Y1) AND
+ (X+I<ViewPort.X2) AND (Y<ViewPort.Y2) Then
+ VideoBuf^[Y*ScreenWidth+X+i]:=TDrawBuffer(Buf)[i];
+ End;
+{$else not DirectWrite}
+ { Pedestrian character method }
+ { Must be in area }
+ If (X+L<ViewPort.X1) OR (Y<ViewPort.Y1) OR
+ (X>=ViewPort.X2) OR (Y>=ViewPort.Y2) Then
+ Exit;
+ For I:=0 to L-1 do Begin
+ P:=Owner;
+ PrevP :=@Self;
+ XI:=X+I;
+ { Must be in area }
+ If (XI<ViewPort.X1) OR
+ (XI>=ViewPort.X2) Then
+ Continue;
+ While Assigned(P) do Begin
+ if not assigned(P^.Buffer) AND
+ (((P^.State AND sfVisible) = 0) OR
+ (P^.Origin.X>XI) OR (P^.Origin.X+P^.Size.X<=XI) OR
+ (P^.Origin.Y>Y) OR (P^.Origin.Y+P^.Size.Y<=Y)) then
+ continue;
+ { Here we must check if X,Y is exposed for this view }
+ PP:=P^.Last;
+ { move to first }
+ If Assigned(PP) then
+ PP:=PP^.Next;
+ While Assigned(PP) and (PP<>P^.Last) and (PP<>PrevP) do Begin
+ If ((PP^.State AND sfVisible) <> 0) AND
+ (PP^.Origin.X>=XI) AND
+ (PP^.Origin.X+PP^.Size.X<XI) AND
+ (PP^.Origin.Y>=Y) AND
+ (PP^.Origin.Y+PP^.Size.Y<Y) then
+ exit;
+ PP:=PP^.Next;
+ End;
+
+ If Assigned(P^.Buffer) then Begin
+ P^.Buffer^[(Y-P^.Origin.Y)*P^.size.X+(XI-P^.Origin.X)]:=TDrawBuffer(Buf)[I];
+ End;
+ PrevP:=P;
+ P:=P^.Owner;
+ End;
+ End;
+{$endif not DirectWrite}
+END;
+
+{define DirectWriteShadow}
+PROCEDURE TView.WriteShadow(X1, Y1, X2, Y2 : Integer);
+VAR
+ P: PGroup;
+ PrevP,PP : PView;
+ CurOrigin : TPoint;
+ I,J : longint;
+ B : Word;
+ ViewPort : ViewPortType;
+BEGIN
+ { Direct wrong method }
+ GetViewSettings(ViewPort, TextModeGFV); { Get set viewport }
+{$ifdef DirectWriteShadow}
+ For J:=Y1 to Y2-1 do Begin
+ For i:=X1 to X2-1 do Begin
+ { if (I>=ViewPort.X1) AND (J>=ViewPort.Y1) AND
+ (I<ViewPort.X2) AND (J<ViewPort.Y2) Then }
+ Begin
+ B:=VideoBuf^[J*ScreenWidth+i];
+ VideoBuf^[J*ScreenWidth+i]:= (B and $7FF);
+ End;
+ End;
+ End;
+{$else not DirectWriteShadow}
+ { Pedestrian character method }
+ { Must be in area }
+ {If (X+L<ViewPort.X1) OR (Y<ViewPort.Y1) OR
+ (X>=ViewPort.X2) OR (Y>=ViewPort.Y2) Then
+ Exit;}
+ For J:=Y1 to Y2-1 do Begin
+ For i:=X1 to X2-1 do Begin
+ P:=Owner;
+ PrevP :=@Self;
+ { Must be in area
+ If (XI<ViewPort.X1) OR
+ (XI>=ViewPort.X2) Then
+ Continue; }
+ While Assigned(P) do Begin
+ if not assigned(P^.Buffer) AND
+ (((P^.State AND sfVisible) = 0) OR
+ (P^.Origin.X>I) OR (P^.Origin.X+P^.Size.X<=I) OR
+ (P^.Origin.Y>J) OR (P^.Origin.Y+P^.Size.Y<=J)) then
+ continue;
+ { Here we must check if X,Y is exposed for this view }
+ PP:=P^.Last;
+ { move to first }
+ If Assigned(PP) then
+ PP:=PP^.Next;
+ While Assigned(PP) and (PP<>P^.Last) and (PP<>PrevP) do Begin
+ If ((PP^.State AND sfVisible) <> 0) AND
+ (PP^.Origin.X>=I) AND
+ (PP^.Origin.X+PP^.Size.X<I) AND
+ (PP^.Origin.Y>=J) AND
+ (PP^.Origin.Y+PP^.Size.Y<J) then
+ continue;
+ PP:=PP^.Next;
+ End;
+
+ If Assigned(P^.Buffer) then Begin
+ B:=P^.Buffer^[(J-P^.Origin.Y)*P^.size.X+(I-P^.Origin.X)];
+ P^.Buffer^[(J-P^.Origin.Y)*P^.size.X+(I-P^.Origin.X)]:= (B and $7FF);
+ End;
+ PrevP:=P;
+ P:=P^.Owner;
+ End;
+ End;
+ End;
+{$endif not DirectWriteShadow}
+END;
+
PROCEDURE TView.DragView (Event: TEvent; Mode: Byte; Var Limits: TRect;
MinSize, MaxSize: TPoint);
VAR PState: Word; Mouse, Q, R, P, S, Op1, Op2: TPoint; SaveBounds: TRect;
@@ -4705,10 +4908,15 @@ END;
{--TGroup-------------------------------------------------------------------}
{ Lock -> Platforms DOS/DPMI/WIN/OS2 - Checked 23Sep97 LdB }
{---------------------------------------------------------------------------}
+{$ifndef NoLock}
+{$define UseLock}
+{$endif ndef NoLock}
PROCEDURE TGroup.Lock;
BEGIN
- If (Buffer <> Nil) OR (LockFlag <> 0)
- Then Inc(LockFlag); { Increment count }
+{$ifdef UseLock}
+ {If (Buffer <> Nil) OR (LockFlag <> 0)
+ Then} Inc(LockFlag); { Increment count }
+{$endif UseLock}
END;
{--TGroup-------------------------------------------------------------------}
@@ -4716,10 +4924,12 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE TGroup.Unlock;
BEGIN
+{$ifdef UseLock}
If (LockFlag <> 0) Then Begin
Dec(LockFlag); { Decrement count }
- {If (LockFlag = 0) Then DrawView;} { Lock release draw }
+ If (LockFlag = 0) Then DrawView; { Lock release draw }
End;
+{$endif UseLock}
END;
PROCEDURE TWindow.DrawBorder;
@@ -4878,7 +5088,10 @@ END.
{
$Log$
- Revision 1.9 2001-05-07 23:36:35 pierre
+ Revision 1.10 2001-05-10 16:46:28 pierre
+ + some improovements made
+
+ Revision 1.9 2001/05/07 23:36:35 pierre
NO_WINDOW cond removed
Revision 1.8 2001/05/04 15:43:46 pierre