paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 00:09:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

new bunch of changes, displays something for dos at least

Browse Source
This commit is contained in:
pierre 2001-05-03 22:32:52 +00:00
parent 39a54db48b
commit 495c9648fa
12 changed files with 496 additions and 148 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
fv/app.pas
View File

@ -280,7 +280,7 @@ TYPE
PROCEDURE PutEvent (Var Event: TEvent); Virtual;
PROCEDURE GetEvent (Var Event: TEvent); Virtual;
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
FUNCTION GetClassName: String; Virtual;
FUNCTION GetClassText: String; Virtual;
FUNCTION GetClassAttr: LongInt; Virtual;
@ -798,6 +798,7 @@ BEGIN
State := sfVisible + sfSelected + sfFocused +
sfModal + sfExposed; { Deafult states }
Options := 0; { No options set }
{$IFNDEF NO_WINDOW}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
ODc := GetDc(GetDeskTopWindow); { Get desktop context }
For I := 0 To 15 Do Begin
@ -812,6 +813,7 @@ BEGIN
{$IFDEF OS_OS2}
CreateWindowNow(swp_Show); { Create app window }
{$ENDIF}
{$ENDIF}
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
AppWindow := HWindow; { Set app window handle }
Size.X := ScreenWidth; { Set x size value }
@ -1083,7 +1085,7 @@ BEGIN
End;
END;
{$IFNDEF OS_DOS}
{$IFNDEF NO_WINDOW}
{***************************************************************************}
{ TProgram OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -1159,9 +1161,9 @@ END;
CONSTRUCTOR TApplication.Init;
BEGIN
InitMemory; { Start memory up }
InitVideo; { Start video up }
InitEvents; { Start event drive }
InitSysError; { Start system error }
Drivers.InitVideo; { Start video up }
Drivers.InitEvents; { Start event drive }
Drivers.InitSysError; { Start system error }
InitHistory; { Start history up }
Inherited Init; { Call ancestor }
END;
@ -1173,9 +1175,9 @@ DESTRUCTOR TApplication.Done;
BEGIN
Inherited Done; { Call ancestor }
DoneHistory; { Close history }
DoneSysError; { Close system error }
DoneEvents; { Close event drive }
DoneVideo; { Close video }
Drivers.DoneSysError; { Close system error }
Drivers.DoneEvents; { Close event drive }
Drivers.DoneVideo; { Close video }
DoneMemory; { Close memory }
END;
@ -1323,7 +1325,10 @@ END;
END.
{
$Log$
Revision 1.4 2001-04-10 21:57:55 pierre
Revision 1.5 2001-05-03 22:32:52 pierre
new bunch of changes, displays something for dos at least
Revision 1.4 2001/04/10 21:57:55 pierre
+ first adds for Use_API define
Revision 1.3 2001/04/10 21:29:54 pierre

25
fv/dialogs.pas
View File

@ -296,7 +296,7 @@ TYPE
PROCEDURE SetData (Var Rec); Virtual;
PROCEDURE Store (Var S: TStream);
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
FUNCTION GetClassName: String; Virtual;
FUNCTION SubClassAttr: LongInt; Virtual;
FUNCTION GetMsgHandler: Pointer; Virtual;
@ -319,7 +319,7 @@ TYPE
PROCEDURE Press (Item: Integer); Virtual;
PROCEDURE MovedTo(Item: Integer); Virtual;
PROCEDURE SetData (Var Rec); Virtual;
{$IFNDEF OS_DOS} { WIN/NT CODE }
{$IFNDEF NO_WINDOW} { WIN/NT CODE }
FUNCTION SubClassAttr: LongInt; Virtual;
{$ENDIF}
END;
@ -333,7 +333,7 @@ TYPE
FUNCTION Mark (Item: Integer): Boolean; Virtual;
PROCEDURE DrawFocus; Virtual;
PROCEDURE Press (Item: Integer); Virtual;
{$IFNDEF OS_DOS} { WIN/NT CODE }
{$IFNDEF NO_WINDOW} { WIN/NT CODE }
FUNCTION SubClassAttr: LongInt; Virtual;
{$ENDIF}
END;
@ -358,7 +358,7 @@ TYPE
PROCEDURE GetData (Var Rec); Virtual;
PROCEDURE SetData (Var Rec); Virtual;
PROCEDURE Store (Var S: TStream);
{$IFNDEF OS_DOS} { WIN/NT CODE }
{$IFNDEF NO_WINDOW} { WIN/NT CODE }
FUNCTION SubClassAttr: LongInt; Virtual;
{$ENDIF}
END;
@ -1757,7 +1757,7 @@ END;
DESTRUCTOR TCluster.Done;
VAR I: Integer;
BEGIN
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
If (WndHandles <> Nil) Then Begin { Handles valid }
For I := 1 To Strings.Count Do { For each entry }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
@ -2147,7 +2147,7 @@ BEGIN
End;
END;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
{***************************************************************************}
{ TCLuster OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -2369,7 +2369,7 @@ BEGIN
Inherited SetData(Rec); { Call ancestor }
END;
{$IFNDEF OS_DOS} { WIN/NT CODE }
{$IFNDEF NO_WINDOW} { WIN/NT CODE }
{***************************************************************************}
{ TRadioButtons OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -2416,7 +2416,7 @@ BEGIN
Inherited Press(Item); { Call ancestor }
END;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
{***************************************************************************}
{ TCheckBoxes OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -2541,7 +2541,7 @@ BEGIN
S.WriteStr(States); { Write strings }
END;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
{***************************************************************************}
{ TMultiCheckBoxes OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -3216,11 +3216,14 @@ END;
END.
{
$Log$
Revision 1.3 2001-04-10 21:29:55 pierre
Revision 1.4 2001-05-03 22:32:52 pierre
new bunch of changes, displays something for dos at least
Revision 1.3 2001/04/10 21:29:55 pierre
* import of Leon de Boer's files
Revision 1.2 2000/08/24 12:00:20 marco
* CVS log and ID tags
}
}

58
fv/drivers.pas
View File

@ -91,7 +91,9 @@ UNIT Drivers;
{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
{$IFNDEF OS_LINUX}
{$S-} { Disable Stack Checking }
{$ENDIF}
{$I-} { Disable IO Checking }
{$Q-} { Disable Overflow Checking }
{$V-} { Turn off strict VAR strings }
@ -124,6 +126,12 @@ USES
BseDos, Os2Def, { Standard units }
{$ENDIF}
{$ENDIF}
{$IFDEF OS_LINUX}
unix,
{$DEFINE Use_API}
{$ENDIF}
{$ifdef Use_API}
video,
{$endif Use_API}
@ -1289,7 +1297,7 @@ END;
{---------------------------------------------------------------------------}
{ GetMousePosition -> Platforms DOS/DPMI - Updated 19May98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE GetMousePosition (Var X, Y: Integer); ASSEMBLER;
PROCEDURE GetMousePosition (Var X, Y: sw_Integer); ASSEMBLER;
{$IFDEF ASM_BP} { BP COMPATABLE ASM }
ASM
MOV AX, $3; { Set function id }
@ -1325,10 +1333,14 @@ END;
{---------------------------------------------------------------------------}
{ ExitDrivers -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Jun98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE ExitDrivers; FAR;
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;
@ -1340,6 +1352,7 @@ procedure DetectVideo;
VAR
CurrMode : TVideoMode;
begin
Video.InitVideo;
GetVideoMode(CurrMode);
ScreenMode:=CurrMode;
end;
@ -1776,8 +1789,8 @@ begin
if Mouse.PollMouseEvent(e) then
begin
Mouse.GetMouseEvent(e);
MouseWhere.X:=e.x;
MouseWhere.Y:=e.y;
MouseWhere.X:=e.x * SysFontWidth;
MouseWhere.Y:=e.y * SysFontHeight;
Event.Double:=false;
case e.Action of
MouseActionMove :
@ -1785,12 +1798,14 @@ begin
MouseActionDown :
begin
Event.What:=evMouseDown;
if (DownButtons=e.Buttons) and (LastWhere.X=e.x) and (LastWhere.Y=e.y) and
if (DownButtons=e.Buttons) and
(LastWhere.X=MouseWhere.X) and
(LastWhere.Y=MouseWhere.Y) and
(GetDosTicks-DownTicks<=DoubleDelay) then
Event.Double:=true;
DownButtons:=e.Buttons;
DownWhere.X:=e.x;
DownWhere.Y:=e.y;
DownWhere.X:=MouseWhere.X;
DownWhere.Y:=MouseWhere.Y;
DownTicks:=GetDosTicks;
AutoTicks:=GetDosTicks;
AutoDelay:=RepeatDelay;
@ -1810,8 +1825,8 @@ begin
end;
end;
Event.Buttons:=e.Buttons;
Event.Where.X:=e.x;
Event.Where.Y:=e.y;
Event.Where.X:=MouseWhere.X;
Event.Where.Y:=MouseWhere.Y;
LastButtons:=Event.Buttons;
LastWhere.x:=Event.Where.x;
LastWhere.y:=Event.Where.y;
@ -2537,17 +2552,24 @@ END;
{ InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE InitVideo;
{$ifndef Use_API}
VAR {$IFDEF OS_DOS} I, J: Integer; Ts: TextSettingsType; {$ENDIF}
VAR {$ifdef Use_API}I, J: Integer;
{$else not Use_API}
{$IFDEF OS_DOS} I, J: Integer;Ts: TextSettingsType;{$ENDIF}
{$IFDEF OS_WINDOWS} Dc, Mem: HDc; TempFont: TLogFont; Tm: TTextmetric; {$ENDIF}
{$IFDEF OS_OS2} Ts, Fs: Integer; Ps: HPs; Tm: FontMetrics; {$ENDIF}
{$endif not Use_API}
{$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 }
@ -2812,11 +2834,15 @@ END;
{ PrintStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 18Feb99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE PrintStr (CONST S: String);
{$IFNDEF OS_DOS} VAR Ts: String; {$ENDIF}
{$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 }
@ -2982,13 +3008,17 @@ BEGIN
DetectVideo; { Detect video }
{$ifdef Use_API}
TextModeGFV:=True;
InitKeyboard;
{$endif Use_API}
SaveExit := ExitProc; { Save old exit }
ExitProc := @ExitDrivers; { Set new exit }
END.
{
$Log$
Revision 1.4 2001-04-10 21:57:55 pierre
Revision 1.5 2001-05-03 22:32:52 pierre
new bunch of changes, displays something for dos at least
Revision 1.4 2001/04/10 21:57:55 pierre
+ first adds for Use_API define
Revision 1.3 2001/04/10 21:29:55 pierre

11
fv/platform.inc
View File

@ -164,10 +164,12 @@ FOR FPC THESE ARE THE TRANSLATIONS
{$DEFINE ASM_FPC}
{$UNDEF BP_VMTLink}
{$DEFINE Use_API}
{$DEFINE NO_WINDOW}
{$ENDIF}
{$IFDEF NoAPI}
{$UNDEF Use_API}
{$UNDEF NO_WINDOW}
{$ENDIF UseAPI}
@ -348,6 +350,10 @@ FOR FPC THESE ARE THE TRANSLATIONS
{$ENDIF}
{$ENDIF}
{$IFDEF OS_DOS}
{$DEFINE NO_WINDOW}
{$ENDIF}
{---------------------------------------------------------------------------}
{ WIN16 AND WIN32 set if in windows - Updated 16Oct2000 LdB }
{---------------------------------------------------------------------------}
@ -363,7 +369,10 @@ FOR FPC THESE ARE THE TRANSLATIONS
{
$Log$
Revision 1.4 2001-04-10 21:57:56 pierre
Revision 1.5 2001-05-03 22:32:52 pierre
new bunch of changes, displays something for dos at least
Revision 1.4 2001/04/10 21:57:56 pierre
+ first adds for Use_API define
Revision 1.3 2001/04/10 21:29:55 pierre

9
fv/validate.pas
View File

@ -1001,7 +1001,7 @@ END;
{ Lookup -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 18May98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TStringLookUpValidator.Lookup (Const S: String): Boolean;
{$IFDEF PPC_VIRTUAL} VAR Index: LongInt; {$ELSE} VAR Index: Integer; {$ENDIF}
{$IFDEF PPC_VIRTUAL} VAR Index: LongInt; {$ELSE} VAR Index: sw_Integer; {$ENDIF}
BEGIN
Lookup := False; { Preset false return }
If (Strings <> Nil) Then
@ -1058,11 +1058,14 @@ END.
{
$Log$
Revision 1.3 2001-04-10 21:29:55 pierre
Revision 1.4 2001-05-03 22:32:52 pierre
new bunch of changes, displays something for dos at least
Revision 1.3 2001/04/10 21:29:55 pierre
* import of Leon de Boer's files
Revision 1.2 2000/08/24 12:00:22 marco
* CVS log and ID tags
}
}

196
fv/views.pas
View File

@ -495,7 +495,7 @@ TYPE
PROCEDURE GetPeerViewPtr (Var S: TStream; Var P);
PROCEDURE PutPeerViewPtr (Var S: TStream; P: PView);
PROCEDURE CalcBounds (Var Bounds: TRect; Delta: TPoint); Virtual;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
FUNCTION GetClassId: LongInt; Virtual;
FUNCTION GetClassName: String; Virtual;
FUNCTION GetClassText: String; Virtual;
@ -530,7 +530,7 @@ TYPE
FUNCTION FontWidth: Integer;
FUNCTION Fontheight: Integer;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
{$ENDIF}
END;
@ -579,7 +579,7 @@ TYPE
PROCEDURE ChangeBounds (Var Bounds: TRect); Virtual;
PROCEDURE GetSubViewPtr (Var S: TStream; Var P);
PROCEDURE PutSubViewPtr (Var S: TStream; P: PView);
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
{$ENDIF}
@ -631,7 +631,7 @@ TYPE
PROCEDURE SetParams (AValue, AMin, AMax, APgStep, AArStep: Integer);
PROCEDURE Store (Var S: TStream);
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
FUNCTION GetClassName: String; Virtual;
FUNCTION GetClassAttr: LongInt; Virtual;
PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
@ -698,7 +698,7 @@ TYPE
PROCEDURE Store (Var S: TStream);
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
PROCEDURE ChangeBounds (Var Bounds: TRect); Virtual;
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{$IFNDEF NO_WINDOW} { WIN/NT CODE }
FUNCTION GetNotifyCmd: LongInt; Virtual;
FUNCTION GetClassName: String; Virtual;
FUNCTION GetClassAttr: LongInt; Virtual;
@ -734,7 +734,7 @@ TYPE
PROCEDURE Store (Var S: TStream);
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
PROCEDURE SizeLimits (Var Min, Max: TPoint); Virtual;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
FUNCTION GetClassText: String; Virtual;
FUNCTION GetClassAttr: LongInt; Virtual;
{$ENDIF}
@ -993,6 +993,10 @@ CONST
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{$ifdef Use_API}
uses
Video;
{$endif Use_API}
{***************************************************************************}
{ PRIVATE CONSTANT DEFINITIONS }
@ -1238,6 +1242,7 @@ BEGIN
LongInt(Tp) := GetProp(LoWord(lParam),
ViewPtr); { Fetch combo ptr }
{$ENDIF}
{$IFNDEF NO_WINDOW}
If (Tp <> Nil) Then Begin { View is valid }
I := SendMessage(LoWord(lParam),
Tp^.GetNotifyCmd, 0, 0); { Get current state }
@ -1246,6 +1251,7 @@ BEGIN
Event.data := I; { Load data value }
Event.InfoPtr := Tp; { Pointer to view }
End;
{$ENDIF}
End;
cbn_SetFocus: Begin { DROP BOX FOCUSED }
{$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
@ -1567,7 +1573,7 @@ BEGIN
FreeMem(HoldLimit, SizeOf(TComplexArea)); { Release memory }
HoldLimit := P; { Shuffle to next }
End;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
If (HWindow <> 0) Then Begin { Handle valid }
S := GetClassName + #0; { Make asciiz }
{$IFDEF OS_WINDOWS} { WIN/NT CODE}
@ -2138,7 +2144,10 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE TView.DrawBackGround;
VAR Bc: Byte; X1, Y1, X2, Y2: Integer; ViewPort: ViewPortType;
{$IFDEF Use_API}X, Y: Integer;
{$ELSE not Use_API}
{$IFDEF OS_DOS} X, Y: Integer; {$ENDIF}
{$ENDIF not Use_API}
{$IFDEF OS_OS2} Ptl: PointL; {$ENDIF}
BEGIN
If (GOptions AND goNoDrawView = 0) Then Begin { Non draw views exit }
@ -2156,6 +2165,20 @@ BEGIN
If (ViewPort.Y2 >= RawOrigin.Y+RawSize.Y) Then
Y2 := RawSize.Y Else { Right to bottom edge }
Y2 := ViewPort.Y2-RawOrigin.Y; { Offset from bottom }
{$IFDEF Use_API} { DOS/DPMI CODE }
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 (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
VideoBuf^[(Y*Drivers.ScreenWidth+X)] := (Bc shl 8) or $20;
End;
UpdateScreen(false);
{$ELSE not Use_API}
{$IFDEF OS_DOS} { DOS/DPMI CODE }
If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV }
SetFillStyle(SolidFill, Bc); { Set fill colour }
@ -2170,8 +2193,8 @@ BEGIN
Bc := GetColor(4); { Disabled back colour }
For Y := Y1 To Y2 Do
For X := X1 To X2 Do Begin
Mem[$B800:$0+(Y*ScreenWidth+X)*2] := $20;
Mem[$B800:$0+(Y*ScreenWidth+X)*2+1] := Bc;
Mem[$B800:$0+(Y*Drivers.ScreenWidth+X)*2] := $20;
Mem[$B800:$0+(Y*Drivers.ScreenWidth+X)*2+1] := Bc;
End;
End;
{$ENDIF}
@ -2193,6 +2216,7 @@ BEGIN
GpiBox(Ps, dro_Fill, Ptl, 0, 0); { Clear the view area }
End;
{$ENDIF}
{$ENDIF not Use_API}
End;
END;
@ -2768,7 +2792,7 @@ END;
{--TView--------------------------------------------------------------------}
{ CalcBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.CalcBounds (Var Bounds: TRect; Delta: TPoint);
PROCEDURE TView.CalcBounds (Var Bounds: Objects.TRect; Delta: TPoint);
VAR S, D: Integer; Min, Max: TPoint;
FUNCTION Range (Val, Min, Max: Integer): Integer;
@ -2778,7 +2802,7 @@ VAR S, D: Integer; Min, Max: TPoint;
Range := Val; { Accept value }
END;
PROCEDURE Grow (Var I: Integer);
PROCEDURE GrowI (Var I: sw_Integer);
BEGIN
If (GrowMode AND gfGrowRel = 0) Then Inc(I, D)
Else I := (I * S + (S - D) SHR 1) DIV (S - D); { Calc grow value }
@ -2790,16 +2814,16 @@ BEGIN
S := Owner^.Size.X; { Set initial size }
D := Delta.X; { Set initial delta }
If (GrowMode AND gfGrowLoX <> 0) Then
Grow(Bounds.A.X); { Grow left side }
GrowI(Bounds.A.X); { Grow left side }
If (GrowMode AND gfGrowHiX <> 0) Then
Grow(Bounds.B.X); { Grow right side }
GrowI(Bounds.B.X); { Grow right side }
If (Bounds.B.X - Bounds.A.X > MaxViewWidth) Then
Bounds.B.X := Bounds.A.X + MaxViewWidth; { Check values }
S := Owner^.Size.Y; D := Delta.Y; { set initial values }
If (GrowMode AND gfGrowLoY <> 0) Then
Grow(Bounds.A.Y); { Grow top side }
GrowI(Bounds.A.Y); { Grow top side }
If (GrowMode AND gfGrowHiY <> 0) Then
Grow(Bounds.B.Y); { grow lower side }
GrowI(Bounds.B.Y); { grow lower side }
SizeLimits(Min, Max); { Check sizes }
Bounds.B.X := Bounds.A.X + Range(Bounds.B.X -
Bounds.A.X, Min.X, Max.X); { Set right side }
@ -2807,7 +2831,7 @@ BEGIN
Bounds.A.Y, Min.Y, Max.Y); { Set lower side }
END;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
{***************************************************************************}
{ TView OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -3283,7 +3307,7 @@ BEGIN
P^.DisplaceBy(Origin.X*FontWidth,
Origin.Y*FontHeight); { Displace old view }
InsertBefore(P, First); { Insert the view }
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
If (HWindow <> 0) Then { We are created }
If (P^.HWindow = 0) Then { Child not created }
P^.CreateWindowNow(0); { Create child window }
@ -3705,7 +3729,7 @@ BEGIN
S.Write(Index, 2); { Write the index }
END;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
{***************************************************************************}
{ TGroup OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -4247,7 +4271,7 @@ BEGIN
End;
END;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
{***************************************************************************}
{ TScrollBar OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -4991,7 +5015,7 @@ BEGIN
VScrollBar^.ArStep); { Update vert bar }
END;
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{$IFNDEF NO_WINDOW} { WIN/NT CODE }
{***************************************************************************}
{ TListViewer OBJECT WIN/NT ONLY METHODS }
{***************************************************************************}
@ -5362,7 +5386,7 @@ BEGIN
Min.Y := MinWinSize.Y; { Set min y size }
END;
{$IFNDEF OS_DOS}
{$IFNDEF NO_WINDOW}
{***************************************************************************}
{ TWindow OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -5576,10 +5600,26 @@ END;
{ ClearArea -> Platforms DOS/DPMI/WIN/OS2 - Checked 19Sep97 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.ClearArea (X1, Y1, X2, Y2: Integer; Colour: Byte);
VAR {$IFDEF OS_DOS} X, Y: Integer; ViewPort: ViewPortType; {$ENDIF}
VAR
{$IFDEF Use_API}X, Y: Integer;
{$ELSE not Use_API}
{$IFDEF OS_DOS} X, Y: Integer; ViewPort: ViewPortType; {$ENDIF}{$ENDIF}
{$IFDEF OS_WINDOWS} ODc: hDc; {$ENDIF}
{$IFDEF OS_OS2} Lp: PointL; OPs: HPs; {$ENDIF}
BEGIN
{$IFDEF Use_API} { DOS/DPMI CODE }
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;
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);
End;
{$ELSE not Use_API}
{$IFDEF OS_DOS} { DOS/DPMI CODE }
GetViewSettings(ViewPort, TextModeGFV); { Get viewport }
If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL GFV MODE }
@ -5594,8 +5634,8 @@ BEGIN
Y2 := (RawOrigin.Y+Y2) DIV SysFontHeight;
For Y := Y1 To Y2 Do
For X := X1 To X2 Do Begin
Mem[$B800:$0+(Y*ScreenWidth+X)*2] := $20;
Mem[$B800:$0+(Y*ScreenWidth+X)*2+1] := Colour SHL 4;
Mem[$B800:$0+(Y*Drivers.ScreenWidth+X)*2] := $20;
Mem[$B800:$0+(Y*Drivers.ScreenWidth+X)*2+1] := Colour SHL 4;
End;
End;
{$ENDIF}
@ -5637,6 +5677,7 @@ BEGIN
Ps := OPs; { Reset held struct }
End;
{$ENDIF}
{$ENDIF not Use_API}
END;
@ -5762,6 +5803,24 @@ BEGIN
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfIconised = 0) AND { View is not icon}
(State AND sfExposed <> 0) AND (W > 0) AND (H > 0) { View is exposed }
{$ifdef Use_API}
then begin
P := @TDrawBuffer(Buf); { Set draw buffer ptr }
L := 0; { Set buffer position }
X := X + Origin.X;
Y := Y + Origin.Y;
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 }
VideoBuf^[((y * Drivers.ScreenWidth)+k)] := P^[L];
Inc(K);
Inc(L); { Next character }
End;
Inc(Y); { Next line down }
end;
Video.UpdateScreen(false);
end;
{$else not Use_API}
{$IFNDEF OS_DOS} AND (HWindow <> 0) {$ENDIF} { WIN/NT/OS2 CODE }
Then Begin
P := @TDrawBuffer(Buf); { Set draw buffer ptr }
@ -5800,8 +5859,8 @@ BEGIN
End Else Begin { TEXT MODE GFV }
Tix := (K + ViewPort.X1) DIV SysFontWidth;
Tiy := (Y + 2 + ViewPort.Y1) DIV SysFontHeight;
Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2] := Lo(P^[L]);
Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2+1] := Hi(P^[L]);
Mem[$B800:$0+((Tiy * Drivers.ScreenWidth)+Tix)*2] := Lo(P^[L]);
Mem[$B800:$0+((Tiy * Drivers.ScreenWidth)+Tix)*2+1] := Hi(P^[L]);
End;
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
@ -5834,6 +5893,7 @@ BEGIN
Ps := OPs; { Restore original PS }
{$ENDIF}
End;
{$endif not Use_API}
END;
PROCEDURE TView.WriteLine (X, Y, W, H: Integer; Var Buf);
@ -5845,6 +5905,22 @@ BEGIN
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfIconised = 0) AND { View is not icon}
(State AND sfExposed <> 0) AND (W > 0) AND (H > 0) { View is exposed }
{$ifdef Use_API}
then begin
P := @TDrawBuffer(Buf); { Set draw buffer ptr }
X := X + Origin.X;
Y := Y + Origin.Y;
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 }
VideoBuf^[((y * Drivers.ScreenWidth)+k)] := P^[I];
Inc(K);
End;
Inc(Y); { Next line down }
end;
Video.UpdateScreen(false);
end;
{$else not Use_API}
{$IFNDEF OS_DOS} AND (HWindow <> 0) {$ENDIF} { WIN/NT/OS2 CODE }
Then Begin
P := @TDrawBuffer(Buf); { Set draw buffer ptr }
@ -5882,8 +5958,8 @@ BEGIN
End Else Begin { TEXT MODE GFV }
Tix := (K + ViewPort.X1) DIV SysFontWidth;
Tiy := (Y + ViewPort.Y1 + 2) DIV SysFontHeight;
Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2] := Lo(P^[I]);
Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2+1] := Hi(P^[I]);
Mem[$B800:$0+((Tiy * Drivers.ScreenWidth)+Tix)*2] := Lo(P^[I]);
Mem[$B800:$0+((Tiy * Drivers.ScreenWidth)+Tix)*2+1] := Hi(P^[I]);
End;
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
@ -5915,6 +5991,7 @@ BEGIN
Ps := OPs; { Restore original PS }
{$ENDIF}
End;
{$endif not Use_API}
END;
{--TView--------------------------------------------------------------------}
@ -5947,7 +6024,9 @@ END;
PROCEDURE TView.WriteStr (X, Y: Integer; Str: String; Color: Byte);
VAR Fc, Bc, B: Byte; X1, Y1, X2, Y2: Integer;
{$IFDEF OS_DOS} Tix, Tiy, Ti: Integer; ViewPort: ViewPortType; {$ENDIF}
{$IFDEF Use_API}Tix, Tiy, Ti: Integer;
{$ELSE not Use_API}
{$IFDEF OS_DOS} Tix, Tiy, Ti: Integer; ViewPort: ViewPortType; {$ENDIF}{$ENDIF}
{$IFDEF OS_WINDOWS} ODc: HDc; P: Pointer; {$ENDIF}
{$IFDEF OS_OS2} OPs: HPs; P: Pointer; Pt: PointL; {$ENDIF}
BEGIN
@ -5967,6 +6046,22 @@ BEGIN
End;
{$IFDEF Use_API}
If (X >= 0) AND (Y >= 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;
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]);
Tix := Tix + SysFontWidth;
end;
UpdateScreen(false);
{$ELSE not Use_API}
{$IFDEF OS_DOS}
If (X >= 0) AND (Y >= 0) Then Begin
X := RawOrigin.X+X*FontWidth; { X position }
@ -5987,8 +6082,8 @@ BEGIN
Tix := X DIV SysFontWidth;
Tiy := Y DIV SysFontHeight;
For Ti := 1 To length(Str) Do Begin
Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2] := Ord(Str[Ti]);
Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2+1] := GetColor(Color);
Mem[$B800:$0+((Tiy * Drivers.ScreenWidth)+Tix)*2] := Ord(Str[Ti]);
Mem[$B800:$0+((Tiy * Drivers.ScreenWidth)+Tix)*2+1] := GetColor(Color);
Tix := Tix + SysFontWidth;
End;
End;
@ -6065,6 +6160,7 @@ BEGIN
Ps := OPs; { Clear device handle }
End;
{$ENDIF}
{$ENDIF not Use_API}
End;
END;
@ -6073,8 +6169,32 @@ PROCEDURE TView.WriteChar (X, Y: Integer; C: Char; Color: Byte;
Count: Integer);
{$IFDEF OS_DOS}
VAR Fc, Bc: Byte; I, Ti, Tix, Tiy: Integer; Col: Word; S: String; ViewPort: ViewPortType;
{$else}
{$ifdef Use_API}
VAR Fc, Bc: Byte; I, Ti, Tix, Tiy: Integer; Col: Word; S: String;
{$endif Use_API}
{$ENDIF}
BEGIN
{$IFDEF Use_API}
Col := GetColor(Color); { Get view color }
Fc := Col AND $0F; { Foreground colour }
Bc := Col AND $F0 SHR 4; { Background colour }
FillChar(S[1], 255, C); { Fill the string }
If (X >= 0) AND (Y >= 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;
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]);
Tix := Tix + SysFontWidth;
end;
UpdateScreen(false);
{$ELSE not Use_API}
{$IFDEF OS_DOS}
If (State AND sfVisible <> 0) AND { View visible }
(State AND sfExposed <> 0) Then Begin { View exposed }
@ -6099,8 +6219,8 @@ BEGIN
Tix := X DIV SysFontWidth;
Tiy := Y DIV SysFontHeight;
For Ti := 1 To length(S) Do Begin
Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2] := Ord(S[Ti]);
Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2+1] := GetColor(Color);
Mem[$B800:$0+((Tiy * Drivers.ScreenWidth)+Tix)*2] := Ord(S[Ti]);
Mem[$B800:$0+((Tiy * Drivers.ScreenWidth)+Tix)*2+1] := GetColor(Color);
Tix := Tix + SysFontWidth;
End;
End;
@ -6109,6 +6229,7 @@ BEGIN
End;
End;
{$ENDIF}
{$ENDIF not Use_API}
END;
PROCEDURE TView.DragView (Event: TEvent; Mode: Byte; Var Limits: TRect;
@ -6260,7 +6381,7 @@ BEGIN
END;
{$IFNDEF OS_DOS}
{$IFNDEF NO_WINDOW}
{***************************************************************************}
{ TView OBJECT WIN/NT ONLY METHODS }
{***************************************************************************}
@ -6663,7 +6784,10 @@ END.
{
$Log$
Revision 1.4 2001-04-10 21:57:56 pierre
Revision 1.5 2001-05-03 22:32:52 pierre
new bunch of changes, displays something for dos at least
Revision 1.4 2001/04/10 21:57:56 pierre
+ first adds for Use_API define
Revision 1.3 2001/04/10 21:29:55 pierre
@ -6673,4 +6797,4 @@ END.
* CVS log and ID tags
}
}

23
fvision/app.pas
View File

@ -280,7 +280,7 @@ TYPE
PROCEDURE PutEvent (Var Event: TEvent); Virtual;
PROCEDURE GetEvent (Var Event: TEvent); Virtual;
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
FUNCTION GetClassName: String; Virtual;
FUNCTION GetClassText: String; Virtual;
FUNCTION GetClassAttr: LongInt; Virtual;
@ -798,6 +798,7 @@ BEGIN
State := sfVisible + sfSelected + sfFocused +
sfModal + sfExposed; { Deafult states }
Options := 0; { No options set }
{$IFNDEF NO_WINDOW}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
ODc := GetDc(GetDeskTopWindow); { Get desktop context }
For I := 0 To 15 Do Begin
@ -812,6 +813,7 @@ BEGIN
{$IFDEF OS_OS2}
CreateWindowNow(swp_Show); { Create app window }
{$ENDIF}
{$ENDIF}
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
AppWindow := HWindow; { Set app window handle }
Size.X := ScreenWidth; { Set x size value }
@ -1083,7 +1085,7 @@ BEGIN
End;
END;
{$IFNDEF OS_DOS}
{$IFNDEF NO_WINDOW}
{***************************************************************************}
{ TProgram OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -1159,9 +1161,9 @@ END;
CONSTRUCTOR TApplication.Init;
BEGIN
InitMemory; { Start memory up }
InitVideo; { Start video up }
InitEvents; { Start event drive }
InitSysError; { Start system error }
Drivers.InitVideo; { Start video up }
Drivers.InitEvents; { Start event drive }
Drivers.InitSysError; { Start system error }
InitHistory; { Start history up }
Inherited Init; { Call ancestor }
END;
@ -1173,9 +1175,9 @@ DESTRUCTOR TApplication.Done;
BEGIN
Inherited Done; { Call ancestor }
DoneHistory; { Close history }
DoneSysError; { Close system error }
DoneEvents; { Close event drive }
DoneVideo; { Close video }
Drivers.DoneSysError; { Close system error }
Drivers.DoneEvents; { Close event drive }
Drivers.DoneVideo; { Close video }
DoneMemory; { Close memory }
END;
@ -1323,7 +1325,10 @@ END;
END.
{
$Log$
Revision 1.4 2001-04-10 21:57:55 pierre
Revision 1.5 2001-05-03 22:32:52 pierre
new bunch of changes, displays something for dos at least
Revision 1.4 2001/04/10 21:57:55 pierre
+ first adds for Use_API define
Revision 1.3 2001/04/10 21:29:54 pierre

25
fvision/dialogs.pas
View File

@ -296,7 +296,7 @@ TYPE
PROCEDURE SetData (Var Rec); Virtual;
PROCEDURE Store (Var S: TStream);
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
FUNCTION GetClassName: String; Virtual;
FUNCTION SubClassAttr: LongInt; Virtual;
FUNCTION GetMsgHandler: Pointer; Virtual;
@ -319,7 +319,7 @@ TYPE
PROCEDURE Press (Item: Integer); Virtual;
PROCEDURE MovedTo(Item: Integer); Virtual;
PROCEDURE SetData (Var Rec); Virtual;
{$IFNDEF OS_DOS} { WIN/NT CODE }
{$IFNDEF NO_WINDOW} { WIN/NT CODE }
FUNCTION SubClassAttr: LongInt; Virtual;
{$ENDIF}
END;
@ -333,7 +333,7 @@ TYPE
FUNCTION Mark (Item: Integer): Boolean; Virtual;
PROCEDURE DrawFocus; Virtual;
PROCEDURE Press (Item: Integer); Virtual;
{$IFNDEF OS_DOS} { WIN/NT CODE }
{$IFNDEF NO_WINDOW} { WIN/NT CODE }
FUNCTION SubClassAttr: LongInt; Virtual;
{$ENDIF}
END;
@ -358,7 +358,7 @@ TYPE
PROCEDURE GetData (Var Rec); Virtual;
PROCEDURE SetData (Var Rec); Virtual;
PROCEDURE Store (Var S: TStream);
{$IFNDEF OS_DOS} { WIN/NT CODE }
{$IFNDEF NO_WINDOW} { WIN/NT CODE }
FUNCTION SubClassAttr: LongInt; Virtual;
{$ENDIF}
END;
@ -1757,7 +1757,7 @@ END;
DESTRUCTOR TCluster.Done;
VAR I: Integer;
BEGIN
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
If (WndHandles <> Nil) Then Begin { Handles valid }
For I := 1 To Strings.Count Do { For each entry }
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
@ -2147,7 +2147,7 @@ BEGIN
End;
END;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
{***************************************************************************}
{ TCLuster OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -2369,7 +2369,7 @@ BEGIN
Inherited SetData(Rec); { Call ancestor }
END;
{$IFNDEF OS_DOS} { WIN/NT CODE }
{$IFNDEF NO_WINDOW} { WIN/NT CODE }
{***************************************************************************}
{ TRadioButtons OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -2416,7 +2416,7 @@ BEGIN
Inherited Press(Item); { Call ancestor }
END;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
{***************************************************************************}
{ TCheckBoxes OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -2541,7 +2541,7 @@ BEGIN
S.WriteStr(States); { Write strings }
END;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
{***************************************************************************}
{ TMultiCheckBoxes OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -3216,11 +3216,14 @@ END;
END.
{
$Log$
Revision 1.3 2001-04-10 21:29:55 pierre
Revision 1.4 2001-05-03 22:32:52 pierre
new bunch of changes, displays something for dos at least
Revision 1.3 2001/04/10 21:29:55 pierre
* import of Leon de Boer's files
Revision 1.2 2000/08/24 12:00:20 marco
* CVS log and ID tags
}
}

58
fvision/drivers.pas
View File

@ -91,7 +91,9 @@ UNIT Drivers;
{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
{$IFNDEF OS_LINUX}
{$S-} { Disable Stack Checking }
{$ENDIF}
{$I-} { Disable IO Checking }
{$Q-} { Disable Overflow Checking }
{$V-} { Turn off strict VAR strings }
@ -124,6 +126,12 @@ USES
BseDos, Os2Def, { Standard units }
{$ENDIF}
{$ENDIF}
{$IFDEF OS_LINUX}
unix,
{$DEFINE Use_API}
{$ENDIF}
{$ifdef Use_API}
video,
{$endif Use_API}
@ -1289,7 +1297,7 @@ END;
{---------------------------------------------------------------------------}
{ GetMousePosition -> Platforms DOS/DPMI - Updated 19May98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE GetMousePosition (Var X, Y: Integer); ASSEMBLER;
PROCEDURE GetMousePosition (Var X, Y: sw_Integer); ASSEMBLER;
{$IFDEF ASM_BP} { BP COMPATABLE ASM }
ASM
MOV AX, $3; { Set function id }
@ -1325,10 +1333,14 @@ END;
{---------------------------------------------------------------------------}
{ ExitDrivers -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Jun98 LdB }
{---------------------------------------------------------------------------}
PROCEDURE ExitDrivers; FAR;
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;
@ -1340,6 +1352,7 @@ procedure DetectVideo;
VAR
CurrMode : TVideoMode;
begin
Video.InitVideo;
GetVideoMode(CurrMode);
ScreenMode:=CurrMode;
end;
@ -1776,8 +1789,8 @@ begin
if Mouse.PollMouseEvent(e) then
begin
Mouse.GetMouseEvent(e);
MouseWhere.X:=e.x;
MouseWhere.Y:=e.y;
MouseWhere.X:=e.x * SysFontWidth;
MouseWhere.Y:=e.y * SysFontHeight;
Event.Double:=false;
case e.Action of
MouseActionMove :
@ -1785,12 +1798,14 @@ begin
MouseActionDown :
begin
Event.What:=evMouseDown;
if (DownButtons=e.Buttons) and (LastWhere.X=e.x) and (LastWhere.Y=e.y) and
if (DownButtons=e.Buttons) and
(LastWhere.X=MouseWhere.X) and
(LastWhere.Y=MouseWhere.Y) and
(GetDosTicks-DownTicks<=DoubleDelay) then
Event.Double:=true;
DownButtons:=e.Buttons;
DownWhere.X:=e.x;
DownWhere.Y:=e.y;
DownWhere.X:=MouseWhere.X;
DownWhere.Y:=MouseWhere.Y;
DownTicks:=GetDosTicks;
AutoTicks:=GetDosTicks;
AutoDelay:=RepeatDelay;
@ -1810,8 +1825,8 @@ begin
end;
end;
Event.Buttons:=e.Buttons;
Event.Where.X:=e.x;
Event.Where.Y:=e.y;
Event.Where.X:=MouseWhere.X;
Event.Where.Y:=MouseWhere.Y;
LastButtons:=Event.Buttons;
LastWhere.x:=Event.Where.x;
LastWhere.y:=Event.Where.y;
@ -2537,17 +2552,24 @@ END;
{ InitVideo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Nov99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE InitVideo;
{$ifndef Use_API}
VAR {$IFDEF OS_DOS} I, J: Integer; Ts: TextSettingsType; {$ENDIF}
VAR {$ifdef Use_API}I, J: Integer;
{$else not Use_API}
{$IFDEF OS_DOS} I, J: Integer;Ts: TextSettingsType;{$ENDIF}
{$IFDEF OS_WINDOWS} Dc, Mem: HDc; TempFont: TLogFont; Tm: TTextmetric; {$ENDIF}
{$IFDEF OS_OS2} Ts, Fs: Integer; Ps: HPs; Tm: FontMetrics; {$ENDIF}
{$endif not Use_API}
{$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 }
@ -2812,11 +2834,15 @@ END;
{ PrintStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 18Feb99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE PrintStr (CONST S: String);
{$IFNDEF OS_DOS} VAR Ts: String; {$ENDIF}
{$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 }
@ -2982,13 +3008,17 @@ BEGIN
DetectVideo; { Detect video }
{$ifdef Use_API}
TextModeGFV:=True;
InitKeyboard;
{$endif Use_API}
SaveExit := ExitProc; { Save old exit }
ExitProc := @ExitDrivers; { Set new exit }
END.
{
$Log$
Revision 1.4 2001-04-10 21:57:55 pierre
Revision 1.5 2001-05-03 22:32:52 pierre
new bunch of changes, displays something for dos at least
Revision 1.4 2001/04/10 21:57:55 pierre
+ first adds for Use_API define
Revision 1.3 2001/04/10 21:29:55 pierre

11
fvision/platform.inc
View File

@ -164,10 +164,12 @@ FOR FPC THESE ARE THE TRANSLATIONS
{$DEFINE ASM_FPC}
{$UNDEF BP_VMTLink}
{$DEFINE Use_API}
{$DEFINE NO_WINDOW}
{$ENDIF}
{$IFDEF NoAPI}
{$UNDEF Use_API}
{$UNDEF NO_WINDOW}
{$ENDIF UseAPI}
@ -348,6 +350,10 @@ FOR FPC THESE ARE THE TRANSLATIONS
{$ENDIF}
{$ENDIF}
{$IFDEF OS_DOS}
{$DEFINE NO_WINDOW}
{$ENDIF}
{---------------------------------------------------------------------------}
{ WIN16 AND WIN32 set if in windows - Updated 16Oct2000 LdB }
{---------------------------------------------------------------------------}
@ -363,7 +369,10 @@ FOR FPC THESE ARE THE TRANSLATIONS
{
$Log$
Revision 1.4 2001-04-10 21:57:56 pierre
Revision 1.5 2001-05-03 22:32:52 pierre
new bunch of changes, displays something for dos at least
Revision 1.4 2001/04/10 21:57:56 pierre
+ first adds for Use_API define
Revision 1.3 2001/04/10 21:29:55 pierre

9
fvision/validate.pas
View File

@ -1001,7 +1001,7 @@ END;
{ Lookup -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 18May98 LdB }
{---------------------------------------------------------------------------}
FUNCTION TStringLookUpValidator.Lookup (Const S: String): Boolean;
{$IFDEF PPC_VIRTUAL} VAR Index: LongInt; {$ELSE} VAR Index: Integer; {$ENDIF}
{$IFDEF PPC_VIRTUAL} VAR Index: LongInt; {$ELSE} VAR Index: sw_Integer; {$ENDIF}
BEGIN
Lookup := False; { Preset false return }
If (Strings <> Nil) Then
@ -1058,11 +1058,14 @@ END.
{
$Log$
Revision 1.3 2001-04-10 21:29:55 pierre
Revision 1.4 2001-05-03 22:32:52 pierre
new bunch of changes, displays something for dos at least
Revision 1.3 2001/04/10 21:29:55 pierre
* import of Leon de Boer's files
Revision 1.2 2000/08/24 12:00:22 marco
* CVS log and ID tags
}
}

196
fvision/views.pas
View File

@ -495,7 +495,7 @@ TYPE
PROCEDURE GetPeerViewPtr (Var S: TStream; Var P);
PROCEDURE PutPeerViewPtr (Var S: TStream; P: PView);
PROCEDURE CalcBounds (Var Bounds: TRect; Delta: TPoint); Virtual;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
FUNCTION GetClassId: LongInt; Virtual;
FUNCTION GetClassName: String; Virtual;
FUNCTION GetClassText: String; Virtual;
@ -530,7 +530,7 @@ TYPE
FUNCTION FontWidth: Integer;
FUNCTION Fontheight: Integer;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
{$ENDIF}
END;
@ -579,7 +579,7 @@ TYPE
PROCEDURE ChangeBounds (Var Bounds: TRect); Virtual;
PROCEDURE GetSubViewPtr (Var S: TStream; Var P);
PROCEDURE PutSubViewPtr (Var S: TStream; P: PView);
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
{$ENDIF}
@ -631,7 +631,7 @@ TYPE
PROCEDURE SetParams (AValue, AMin, AMax, APgStep, AArStep: Integer);
PROCEDURE Store (Var S: TStream);
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
FUNCTION GetClassName: String; Virtual;
FUNCTION GetClassAttr: LongInt; Virtual;
PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
@ -698,7 +698,7 @@ TYPE
PROCEDURE Store (Var S: TStream);
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
PROCEDURE ChangeBounds (Var Bounds: TRect); Virtual;
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{$IFNDEF NO_WINDOW} { WIN/NT CODE }
FUNCTION GetNotifyCmd: LongInt; Virtual;
FUNCTION GetClassName: String; Virtual;
FUNCTION GetClassAttr: LongInt; Virtual;
@ -734,7 +734,7 @@ TYPE
PROCEDURE Store (Var S: TStream);
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
PROCEDURE SizeLimits (Var Min, Max: TPoint); Virtual;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
FUNCTION GetClassText: String; Virtual;
FUNCTION GetClassAttr: LongInt; Virtual;
{$ENDIF}
@ -993,6 +993,10 @@ CONST
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{$ifdef Use_API}
uses
Video;
{$endif Use_API}
{***************************************************************************}
{ PRIVATE CONSTANT DEFINITIONS }
@ -1238,6 +1242,7 @@ BEGIN
LongInt(Tp) := GetProp(LoWord(lParam),
ViewPtr); { Fetch combo ptr }
{$ENDIF}
{$IFNDEF NO_WINDOW}
If (Tp <> Nil) Then Begin { View is valid }
I := SendMessage(LoWord(lParam),
Tp^.GetNotifyCmd, 0, 0); { Get current state }
@ -1246,6 +1251,7 @@ BEGIN
Event.data := I; { Load data value }
Event.InfoPtr := Tp; { Pointer to view }
End;
{$ENDIF}
End;
cbn_SetFocus: Begin { DROP BOX FOCUSED }
{$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
@ -1567,7 +1573,7 @@ BEGIN
FreeMem(HoldLimit, SizeOf(TComplexArea)); { Release memory }
HoldLimit := P; { Shuffle to next }
End;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
If (HWindow <> 0) Then Begin { Handle valid }
S := GetClassName + #0; { Make asciiz }
{$IFDEF OS_WINDOWS} { WIN/NT CODE}
@ -2138,7 +2144,10 @@ END;
{---------------------------------------------------------------------------}
PROCEDURE TView.DrawBackGround;
VAR Bc: Byte; X1, Y1, X2, Y2: Integer; ViewPort: ViewPortType;
{$IFDEF Use_API}X, Y: Integer;
{$ELSE not Use_API}
{$IFDEF OS_DOS} X, Y: Integer; {$ENDIF}
{$ENDIF not Use_API}
{$IFDEF OS_OS2} Ptl: PointL; {$ENDIF}
BEGIN
If (GOptions AND goNoDrawView = 0) Then Begin { Non draw views exit }
@ -2156,6 +2165,20 @@ BEGIN
If (ViewPort.Y2 >= RawOrigin.Y+RawSize.Y) Then
Y2 := RawSize.Y Else { Right to bottom edge }
Y2 := ViewPort.Y2-RawOrigin.Y; { Offset from bottom }
{$IFDEF Use_API} { DOS/DPMI CODE }
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 (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
VideoBuf^[(Y*Drivers.ScreenWidth+X)] := (Bc shl 8) or $20;
End;
UpdateScreen(false);
{$ELSE not Use_API}
{$IFDEF OS_DOS} { DOS/DPMI CODE }
If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV }
SetFillStyle(SolidFill, Bc); { Set fill colour }
@ -2170,8 +2193,8 @@ BEGIN
Bc := GetColor(4); { Disabled back colour }
For Y := Y1 To Y2 Do
For X := X1 To X2 Do Begin
Mem[$B800:$0+(Y*ScreenWidth+X)*2] := $20;
Mem[$B800:$0+(Y*ScreenWidth+X)*2+1] := Bc;
Mem[$B800:$0+(Y*Drivers.ScreenWidth+X)*2] := $20;
Mem[$B800:$0+(Y*Drivers.ScreenWidth+X)*2+1] := Bc;
End;
End;
{$ENDIF}
@ -2193,6 +2216,7 @@ BEGIN
GpiBox(Ps, dro_Fill, Ptl, 0, 0); { Clear the view area }
End;
{$ENDIF}
{$ENDIF not Use_API}
End;
END;
@ -2768,7 +2792,7 @@ END;
{--TView--------------------------------------------------------------------}
{ CalcBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.CalcBounds (Var Bounds: TRect; Delta: TPoint);
PROCEDURE TView.CalcBounds (Var Bounds: Objects.TRect; Delta: TPoint);
VAR S, D: Integer; Min, Max: TPoint;
FUNCTION Range (Val, Min, Max: Integer): Integer;
@ -2778,7 +2802,7 @@ VAR S, D: Integer; Min, Max: TPoint;
Range := Val; { Accept value }
END;
PROCEDURE Grow (Var I: Integer);
PROCEDURE GrowI (Var I: sw_Integer);
BEGIN
If (GrowMode AND gfGrowRel = 0) Then Inc(I, D)
Else I := (I * S + (S - D) SHR 1) DIV (S - D); { Calc grow value }
@ -2790,16 +2814,16 @@ BEGIN
S := Owner^.Size.X; { Set initial size }
D := Delta.X; { Set initial delta }
If (GrowMode AND gfGrowLoX <> 0) Then
Grow(Bounds.A.X); { Grow left side }
GrowI(Bounds.A.X); { Grow left side }
If (GrowMode AND gfGrowHiX <> 0) Then
Grow(Bounds.B.X); { Grow right side }
GrowI(Bounds.B.X); { Grow right side }
If (Bounds.B.X - Bounds.A.X > MaxViewWidth) Then
Bounds.B.X := Bounds.A.X + MaxViewWidth; { Check values }
S := Owner^.Size.Y; D := Delta.Y; { set initial values }
If (GrowMode AND gfGrowLoY <> 0) Then
Grow(Bounds.A.Y); { Grow top side }
GrowI(Bounds.A.Y); { Grow top side }
If (GrowMode AND gfGrowHiY <> 0) Then
Grow(Bounds.B.Y); { grow lower side }
GrowI(Bounds.B.Y); { grow lower side }
SizeLimits(Min, Max); { Check sizes }
Bounds.B.X := Bounds.A.X + Range(Bounds.B.X -
Bounds.A.X, Min.X, Max.X); { Set right side }
@ -2807,7 +2831,7 @@ BEGIN
Bounds.A.Y, Min.Y, Max.Y); { Set lower side }
END;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
{***************************************************************************}
{ TView OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -3283,7 +3307,7 @@ BEGIN
P^.DisplaceBy(Origin.X*FontWidth,
Origin.Y*FontHeight); { Displace old view }
InsertBefore(P, First); { Insert the view }
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
If (HWindow <> 0) Then { We are created }
If (P^.HWindow = 0) Then { Child not created }
P^.CreateWindowNow(0); { Create child window }
@ -3705,7 +3729,7 @@ BEGIN
S.Write(Index, 2); { Write the index }
END;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
{***************************************************************************}
{ TGroup OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -4247,7 +4271,7 @@ BEGIN
End;
END;
{$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
{$IFNDEF NO_WINDOW} { WIN/NT/OS2 CODE }
{***************************************************************************}
{ TScrollBar OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -4991,7 +5015,7 @@ BEGIN
VScrollBar^.ArStep); { Update vert bar }
END;
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
{$IFNDEF NO_WINDOW} { WIN/NT CODE }
{***************************************************************************}
{ TListViewer OBJECT WIN/NT ONLY METHODS }
{***************************************************************************}
@ -5362,7 +5386,7 @@ BEGIN
Min.Y := MinWinSize.Y; { Set min y size }
END;
{$IFNDEF OS_DOS}
{$IFNDEF NO_WINDOW}
{***************************************************************************}
{ TWindow OBJECT WIN/NT/OS2 ONLY METHODS }
{***************************************************************************}
@ -5576,10 +5600,26 @@ END;
{ ClearArea -> Platforms DOS/DPMI/WIN/OS2 - Checked 19Sep97 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TView.ClearArea (X1, Y1, X2, Y2: Integer; Colour: Byte);
VAR {$IFDEF OS_DOS} X, Y: Integer; ViewPort: ViewPortType; {$ENDIF}
VAR
{$IFDEF Use_API}X, Y: Integer;
{$ELSE not Use_API}
{$IFDEF OS_DOS} X, Y: Integer; ViewPort: ViewPortType; {$ENDIF}{$ENDIF}
{$IFDEF OS_WINDOWS} ODc: hDc; {$ENDIF}
{$IFDEF OS_OS2} Lp: PointL; OPs: HPs; {$ENDIF}
BEGIN
{$IFDEF Use_API} { DOS/DPMI CODE }
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;
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);
End;
{$ELSE not Use_API}
{$IFDEF OS_DOS} { DOS/DPMI CODE }
GetViewSettings(ViewPort, TextModeGFV); { Get viewport }
If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL GFV MODE }
@ -5594,8 +5634,8 @@ BEGIN
Y2 := (RawOrigin.Y+Y2) DIV SysFontHeight;
For Y := Y1 To Y2 Do
For X := X1 To X2 Do Begin
Mem[$B800:$0+(Y*ScreenWidth+X)*2] := $20;
Mem[$B800:$0+(Y*ScreenWidth+X)*2+1] := Colour SHL 4;
Mem[$B800:$0+(Y*Drivers.ScreenWidth+X)*2] := $20;
Mem[$B800:$0+(Y*Drivers.ScreenWidth+X)*2+1] := Colour SHL 4;
End;
End;
{$ENDIF}
@ -5637,6 +5677,7 @@ BEGIN
Ps := OPs; { Reset held struct }
End;
{$ENDIF}
{$ENDIF not Use_API}
END;
@ -5762,6 +5803,24 @@ BEGIN
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfIconised = 0) AND { View is not icon}
(State AND sfExposed <> 0) AND (W > 0) AND (H > 0) { View is exposed }
{$ifdef Use_API}
then begin
P := @TDrawBuffer(Buf); { Set draw buffer ptr }
L := 0; { Set buffer position }
X := X + Origin.X;
Y := Y + Origin.Y;
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 }
VideoBuf^[((y * Drivers.ScreenWidth)+k)] := P^[L];
Inc(K);
Inc(L); { Next character }
End;
Inc(Y); { Next line down }
end;
Video.UpdateScreen(false);
end;
{$else not Use_API}
{$IFNDEF OS_DOS} AND (HWindow <> 0) {$ENDIF} { WIN/NT/OS2 CODE }
Then Begin
P := @TDrawBuffer(Buf); { Set draw buffer ptr }
@ -5800,8 +5859,8 @@ BEGIN
End Else Begin { TEXT MODE GFV }
Tix := (K + ViewPort.X1) DIV SysFontWidth;
Tiy := (Y + 2 + ViewPort.Y1) DIV SysFontHeight;
Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2] := Lo(P^[L]);
Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2+1] := Hi(P^[L]);
Mem[$B800:$0+((Tiy * Drivers.ScreenWidth)+Tix)*2] := Lo(P^[L]);
Mem[$B800:$0+((Tiy * Drivers.ScreenWidth)+Tix)*2+1] := Hi(P^[L]);
End;
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
@ -5834,6 +5893,7 @@ BEGIN
Ps := OPs; { Restore original PS }
{$ENDIF}
End;
{$endif not Use_API}
END;
PROCEDURE TView.WriteLine (X, Y, W, H: Integer; Var Buf);
@ -5845,6 +5905,22 @@ BEGIN
If (State AND sfVisible <> 0) AND { View is visible }
(State AND sfIconised = 0) AND { View is not icon}
(State AND sfExposed <> 0) AND (W > 0) AND (H > 0) { View is exposed }
{$ifdef Use_API}
then begin
P := @TDrawBuffer(Buf); { Set draw buffer ptr }
X := X + Origin.X;
Y := Y + Origin.Y;
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 }
VideoBuf^[((y * Drivers.ScreenWidth)+k)] := P^[I];
Inc(K);
End;
Inc(Y); { Next line down }
end;
Video.UpdateScreen(false);
end;
{$else not Use_API}
{$IFNDEF OS_DOS} AND (HWindow <> 0) {$ENDIF} { WIN/NT/OS2 CODE }
Then Begin
P := @TDrawBuffer(Buf); { Set draw buffer ptr }
@ -5882,8 +5958,8 @@ BEGIN
End Else Begin { TEXT MODE GFV }
Tix := (K + ViewPort.X1) DIV SysFontWidth;
Tiy := (Y + ViewPort.Y1 + 2) DIV SysFontHeight;
Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2] := Lo(P^[I]);
Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2+1] := Hi(P^[I]);
Mem[$B800:$0+((Tiy * Drivers.ScreenWidth)+Tix)*2] := Lo(P^[I]);
Mem[$B800:$0+((Tiy * Drivers.ScreenWidth)+Tix)*2+1] := Hi(P^[I]);
End;
{$ENDIF}
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
@ -5915,6 +5991,7 @@ BEGIN
Ps := OPs; { Restore original PS }
{$ENDIF}
End;
{$endif not Use_API}
END;
{--TView--------------------------------------------------------------------}
@ -5947,7 +6024,9 @@ END;
PROCEDURE TView.WriteStr (X, Y: Integer; Str: String; Color: Byte);
VAR Fc, Bc, B: Byte; X1, Y1, X2, Y2: Integer;
{$IFDEF OS_DOS} Tix, Tiy, Ti: Integer; ViewPort: ViewPortType; {$ENDIF}
{$IFDEF Use_API}Tix, Tiy, Ti: Integer;
{$ELSE not Use_API}
{$IFDEF OS_DOS} Tix, Tiy, Ti: Integer; ViewPort: ViewPortType; {$ENDIF}{$ENDIF}
{$IFDEF OS_WINDOWS} ODc: HDc; P: Pointer; {$ENDIF}
{$IFDEF OS_OS2} OPs: HPs; P: Pointer; Pt: PointL; {$ENDIF}
BEGIN
@ -5967,6 +6046,22 @@ BEGIN
End;
{$IFDEF Use_API}
If (X >= 0) AND (Y >= 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;
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]);
Tix := Tix + SysFontWidth;
end;
UpdateScreen(false);
{$ELSE not Use_API}
{$IFDEF OS_DOS}
If (X >= 0) AND (Y >= 0) Then Begin
X := RawOrigin.X+X*FontWidth; { X position }
@ -5987,8 +6082,8 @@ BEGIN
Tix := X DIV SysFontWidth;
Tiy := Y DIV SysFontHeight;
For Ti := 1 To length(Str) Do Begin
Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2] := Ord(Str[Ti]);
Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2+1] := GetColor(Color);
Mem[$B800:$0+((Tiy * Drivers.ScreenWidth)+Tix)*2] := Ord(Str[Ti]);
Mem[$B800:$0+((Tiy * Drivers.ScreenWidth)+Tix)*2+1] := GetColor(Color);
Tix := Tix + SysFontWidth;
End;
End;
@ -6065,6 +6160,7 @@ BEGIN
Ps := OPs; { Clear device handle }
End;
{$ENDIF}
{$ENDIF not Use_API}
End;
END;
@ -6073,8 +6169,32 @@ PROCEDURE TView.WriteChar (X, Y: Integer; C: Char; Color: Byte;
Count: Integer);
{$IFDEF OS_DOS}
VAR Fc, Bc: Byte; I, Ti, Tix, Tiy: Integer; Col: Word; S: String; ViewPort: ViewPortType;
{$else}
{$ifdef Use_API}
VAR Fc, Bc: Byte; I, Ti, Tix, Tiy: Integer; Col: Word; S: String;
{$endif Use_API}
{$ENDIF}
BEGIN
{$IFDEF Use_API}
Col := GetColor(Color); { Get view color }
Fc := Col AND $0F; { Foreground colour }
Bc := Col AND $F0 SHR 4; { Background colour }
FillChar(S[1], 255, C); { Fill the string }
If (X >= 0) AND (Y >= 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;
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]);
Tix := Tix + SysFontWidth;
end;
UpdateScreen(false);
{$ELSE not Use_API}
{$IFDEF OS_DOS}
If (State AND sfVisible <> 0) AND { View visible }
(State AND sfExposed <> 0) Then Begin { View exposed }
@ -6099,8 +6219,8 @@ BEGIN
Tix := X DIV SysFontWidth;
Tiy := Y DIV SysFontHeight;
For Ti := 1 To length(S) Do Begin
Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2] := Ord(S[Ti]);
Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2+1] := GetColor(Color);
Mem[$B800:$0+((Tiy * Drivers.ScreenWidth)+Tix)*2] := Ord(S[Ti]);
Mem[$B800:$0+((Tiy * Drivers.ScreenWidth)+Tix)*2+1] := GetColor(Color);
Tix := Tix + SysFontWidth;
End;
End;
@ -6109,6 +6229,7 @@ BEGIN
End;
End;
{$ENDIF}
{$ENDIF not Use_API}
END;
PROCEDURE TView.DragView (Event: TEvent; Mode: Byte; Var Limits: TRect;
@ -6260,7 +6381,7 @@ BEGIN
END;
{$IFNDEF OS_DOS}
{$IFNDEF NO_WINDOW}
{***************************************************************************}
{ TView OBJECT WIN/NT ONLY METHODS }
{***************************************************************************}
@ -6663,7 +6784,10 @@ END.
{
$Log$
Revision 1.4 2001-04-10 21:57:56 pierre
Revision 1.5 2001-05-03 22:32:52 pierre
new bunch of changes, displays something for dos at least
Revision 1.4 2001/04/10 21:57:56 pierre
+ first adds for Use_API define
Revision 1.3 2001/04/10 21:29:55 pierre
@ -6673,4 +6797,4 @@ END.
* CVS log and ID tags
}
}